Příspěvky uživatele


< návrat zpět

Strana:  1 2 3 4 5 6 7 8 9   další » ... 16

Dobrý den,
také jsem dost dlouho řešil tento problém, jak spolehlivě pracovat s jedním souborem pro více uživatelů. Bohužel sdílení nebylo to pravé.
Pokud sešit na cloudu otevře někdo v prohlížeči, nefungují makra, při sdílení v aplikaci platí zásada, kdo poslední provede úpravu buňky, toho změny se zapíší.

Nakonec jsem to celé řešil jedním "datovým" souborem a jedním "ovládacím" souborem.
Oba soubory na sdíleném úložišti mají nastaven atribut pro čtení (ovládací soubor pak bez sdílení může otevřít více uživatelů), datový soubor je pak ve skrytém adresáři.
Celá práce s daty spočívá v načtení dat pro uživatele podle oprávnění. Při ukládání změn do souboru pak kontroluji atribut R datového souboru a případně i čas poslední změny a nově ukládám pouze změny od konkrétního uživatele.

Tohle by po menší úpravě mohlo pro výpis souborů vyhovovat.

Zkusil bych to přes soubor.
Nejprve data uložit do souboru a ten pak otevřít v NotePadu.
Např.:
Sub CopyToNotepad(strText as String)
Dim objFSO As Object
Dim objFile As Object

' Vytvoření objektu FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Vytvoření a otevření textového souboru
Set objFile = objFSO.CreateTextFile("C:\Temp\output.txt", True)

' Zapsání textu do souboru
objFile.WriteLine strText

' Zavření souboru
objFile.Close

' Otevření Notepadu s vytvořeným souborem
Shell "notepad.exe C:\Temp\output.txt", vbNormalFocus
End Sub

Díky, tak tohle zabralo.
A pokud by bylo nutné přidat text ještě za KT jakým příkazem?
.InertAfter "text"

Tak jsem se konečně dostal k testu.
.InsertBreakvyhazuje chybu "Metoda nebo vlastnost není k dispozici, protože je dokument uzamčen pro úpravy."
Domnívám se, že je to "vlastnost" bezpečnostní politiky firmy.

Jediné kdy se mi podařilo vložit KT do textu je: Set WrdDoc = OutMail.GetInspector.WordEditor
shs_kt1.PivotTables("KT1").TableRange1.Copy
WrdDoc.Range.PasteSpecial
ale tam zase narážím na problém, že mi předchozí text vymaže a vkládá tak data "do čistého". Potřebuji vložit text a 4 KT pod sebe.

Spolehlivá metoda je vytvořit ze všech KT samostatný sešit a ten vložit jako přílohu - ovšem pak nesmí nikdo aktualizovat KT v této příloze, protože nenajde zdorj dat.

Jinak naprosto souhlasím s těmi super změnami v MSO u mě též podpořené bezpečnostní politikou. A to netuším co mě bude čekat při přechodu na W11...

Zdravím, potřeboval bych pomoci s makrem, které vloží kontingeční tabulku do textu emailu.

Private Sub OdesliEmailReportu()
' odeslání vytvořeného reportu (KT1 - KT4)

Dim OutApp As Object, OutMail As Object
Dim strAdresat As String, strSubject As String, strBody As String

strAdresat = "adresaprijemce@neco.cz"
strSubject = "Report dne " & Format(Date, "d.m.yyyy")
strBody = "Zasílám vybrané tabulky:"

On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = strAdresat
.Subject = strSubject
.body = strBody

.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

KT je uložena na samostatném listu jako KT1
Díky za pomoc

Jediné co mne narychlo napadá je jednorázově spustit:
Sub Email()

Dim hodnota As String
Dim i As Long

With List1
For i = 5 To .Cells(Rows.Count, 1).End(xlUp).Row
hodnota = .Cells(i, 2)
If hodnota <> Empty Then
.Hyperlinks.Add .Cells(i, 2), "mailto:" & hodnota
End If
Next i
End With

End Sub

PavDD napsal/a:

If konecForm Then 'MsgBox "zmačknul jsi storno"
Exit For
GoTo konec
End If

If konecForm Then
Exit For
GoTo konec
End If

nechal jsem záměrně dvě možnosti jak vyskočit z cyklu
Exit for vyskočí za konec cyklu (Next i)
GoTo konec skočí na návěští konec, tedy přeskočí vše mezi Next i a návěští.
Stačí jen zakomentovat, nebo vynechat, nechtěné ukončení, v tomto případě Exit For

Jinak vynucení deklarace proměnných velice doporučuji včetně deklarace jejich datových typů. https://wall.cz/excel-navod/deklarace-promennych-a-prehled-datovych-typu-vba

Ne to nestačí a navíc by to skončilo chybou.

...Nyní , když stisknu Storno, stejně to čeká ...na pozadí až to odpočítá temch 5 sec....
Protože není stisk tlačítka ošetřen tak, aby přerušil cyklus odpočtu. Zkuste si kód krokovat a uvidíte i příčinu toho, proč se cyklus nepřeruší.

...Možná by pomohlo obecně vysvětlit, jak funguje v obecném formuláři tlačítko Storno, a tl Přerušit. Přerušit taky ukonší chod makra?...
Obecně tlačítka fungují tak, jak je programátor naprogramuje.

Co myslíte tlačítkem Storno a co tlačítkem Přerušit?

...A ještě jeden dotaz, lze schovat křížek v pravém rohu formuláře?...
Jednodušší je zakázat stisk ikony zavření formuláře pomocí metody Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
Cancel = 1
End If
End Sub
CloseMode určuje příčinu vyvolání - 0=> zavření form z nabídky (křížek)
Cancel nastavením na jinou hodnotu než 0 zastaví událost QueryClose.

Dík za upozornění.
Chyba při použití přepisu do EN verze (používám záznam makra k získání EN vzorce).
EN: =IF(F10<DATE(YEAR(TODAY()),7,20),"20.07."&YEAR(TODAY()),"20.07."&YEAR(TODAY())+1)
Já to pochopil tak, že když je aktuální datum menší než požadovaný, tak je výsledek 20.7. aktuálního roku a po dosažení datumu 20.7. se zvýší o 1 rok.
Tedy dle Vašeho vzorce:
CZ: =DATUM(ROK(F10)+(F10>DATUM(ROK(F10);7;20));7;20)
EN: =DATE(YEAR(F10)+(F10>DATE(YEAR(F10);7;20));7;20)


ale je to "jen" o znaménku +/- ve vzorci.

Použít vyhodnocení stavu buňky F10 např.:
CZ: =KDYŽ(F10<DATUM(ROK(DNES());7;20);"20.07."&ROK(DNES());"20.07."&ROK(DNES())+1)
EN: =IF(F10<DATE(YEAR(TODAY()),7,20),""20.07.""&YEAR(TODAY()),""20.07.""&YEAR(TODAY())+1)

Pomocný sloupec O bude obsahovat součet všech hodnot požadovaných v buňce F6, pro O3=L3+M3+N3
buňka F6 pak bude mít vzorecCZ: =SVYHLEDAT(E6;K:O;5;0)
EN: =VLOOKUP(E6;K:O;5;0)

Více https://support.microsoft.com/cs-cz/office/svyhledat-funkce-0bbc8083-26fe-4963-8ab8-93a18ad188a1

Pokud jsem to pochopil správně, pak např.:
buňka E6CZ: =DATUM(ROK(DNES());12;31)
EN: =DATE(YEAR(TODAY()),12,31)

buňka F6CZ: =SVYHLEDAT(E6;K:L;2;0)
EN: =VLOOKUP(E6;K:L;2;0)

Použijte
Sub vlastnizahlavi()

Dim poznamka As String

poznamka = InputBox("Zadej vlastní záhlaví :", "OKNO", "")

With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Text 123456 + : " & poznamka
.RightHeader = ""
End With

End Sub


Strana:  1 2 3 4 5 6 7 8 9   další » ... 16

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje