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
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....
...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?...
...A ještě jeden dotaz, lze schovat křížek v pravém rohu formuláře?...
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
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.