Příspěvky uživatele
< návrat zpět
Případně lze řešit doplněním vzorců pomocí makra.
Sub DoplnDataZeSouboru()
Dim listCil As Worksheet
Dim cesta As String, soubor As String, listCilJmeno As String
Dim vzorec As String, hodnotaNenalezeno As String
Dim radekDatum As Long, radekDataStart As Long, radekDataKonec As Long
Dim sloupecStart As Long, sloupecKonec As Long
Dim i As Long
Application.DisplayAlerts = False
Set listCil = Worksheets("List1") ' list kam se budou data ukládat
listCilJmeno = "PRAHA" ' jméno zdrojového listu
cesta = ThisWorkbook.Path ' cesta k souborům
radekDatum = 3 ' řádek s datumy (názvy souborů)
radekDataStart = 4 ' první řádek se jmény
sloupecStart = 2 ' první sloupec s datumem
hodnotaNenalezeno = "Nenalezeno" ' text v případě nenalezené shody
With listCil
radekDataKonec = .Cells(Rows.Count, "A").End(xlUp).Row ' poslední obsazený řádek
sloupecKonec = .Cells(radekDatum, Columns.Count).End(xlToLeft).Column ' poslední obsazený sloupec
End With
For i = sloupecStart To sloupecKonec
With listCil
soubor = Format(.Cells(radekDatum, i), "dd.mm.yyyy") & ".xlsx" ' jméno zdrojového souboru
vzorec = "=IFERROR(VLOOKUP(A" & radekDataStart & ",'" & cesta & "\[" & soubor & "]" & listCilJmeno & "'!$B:$Y,23,0),""" & hodnotaNenalezeno & """)" ' vzorec pro SVYHLEDAT
With .Range(.Cells(radekDataStart, i), .Cells(radekDataKonec, i))
.Formula = vzorec ' vloží vzorec
.Value = .Value ' převod na hodnoty
End With
End With
Next i
Application.DisplayAlerts = True
End Sub
Lze i doplnit o test, zda soubor existuje nebo nikoliv.
Pouhé použití s vzorcem s využitím INDIRECT (NEPŘÍMÝ.ODKAZ) vyžaduje otevřený sešit, jinak vrací chybu #ODKAZ
zkusil bych vložit čekací smyčku dokud SAP nedokončí akci
Do While Session.Busy
DoEvents
Loop
mohlo by to pomoci.
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....
...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?...
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?...
If CloseMode = 0 Then
Cancel = 1
End If
End SubCloseMode 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
Uživatelské menu
\nFormulář 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.
RSS nejnovější články