No skúste
Příloha: 
53266_export-pdf-pokus-bez-copy.zip (168kB, staženo 7x)
citovat53266_export-pdf-pokus-bez-copy.zip (168kB, staženo 7x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: List do *pdf
Úprava je jednoduchá. A žiadne adresáre si vytvárať nemusíte. Makro si ich vytvorí samo. Upravil som kód na danú štruktúru.
Takže sa odošle pomocou predvoleného účtu v Outlooku. To je takisto jednoduché, vyremujeme všetko ohľadom oUcet (inak správne, "vyremovať" znamená dať apostrof - odstaviť kód :) )
no skúste, či som uhádol, čo tým myslíte...
Všetky 3 úpravy som zatiaľ urobil len vyremovaním a malou úpravou kódu. Ak to bude správne, vyremované časti odstrániť.
PS: A čo ten MAIL_ADRESAT? Odkiaľ sa má brať? Z nejakej bunky, alebo manuálne?
MS Excel
Téma: List do *pdf 
Zaslal/a Alfan 24.8.2022 10:12
Dobrý den, nemáte někdo makro na uložení konkrétního listu do pdf?
Tohle se mi nedaří rozchodit 
Díky.
RAdek
Sub doPDF()
Dim wList As Worksheet
Dim sDir As String
Dim i As Integer
Set wList = List2 'sem napíšeš list, který se má zpracovat
sDir = ThisWorkbook.Path & "\pdf\"
wList.Copy
ActiveWorkbook.SaveAs sDir & IIf(Right(sDir, 1) <> "\", "\", "") & wList.Name & " - " & c2 & ".pdf", FileFormat:=xlTypePDF, CreateBackup:=False, Local:=True
MsgBox ("Uloženo")
Application.StatusBar = False
End Sub
Děkuji.
Já myslel, že lze nějak ve vzorcích použít název toto Sliceru?
Tato řešení jsou řešeními, ale přišlo mi "elegantnější", kdyby excel uměl právě přes ten název (de facto něco jako oblast) využít ho ve vzorci.
Ale i tak díky.
Radekcitovat
Já myslel, že lze nějak ve vzorcích použít název toto Sliceru?
Tato řešení jsou řešeními, ale přišlo mi "elegantnější", kdyby excel uměl právě přes ten název (de facto něco jako oblast) využít ho ve vzorci.
Ale i tak díky.
Radekcitovat
Zkusil jsem vložit do toho kódu na *.pdf ještě odesílání emailem, ale hlásí mi to chyby.
Ono to nahlásí kritickou chybu a já pak nevím, kde je chyba?
Co tam má špatně? Pořadí?
Sub doPDF_bezCOPY_proHS_email()
Dim sDir As String
Dim MyDate, MyTime, MyStr, MyStr1
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
MyTime = Time
MyDate = Date
'MyStr1 = Format(MyTime, "hh-mm-ss")
MyStr = Format(MyDate, "yyyy-mm-dd") 'Rozhoduje pořadí, bere se ta poslední varianta, řádek
sDir = ThisWorkbook.Path & "\__pdfhs\"
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error GoTo KONEC
'With List2 'sem napíšeš list, který se má zpracovat
With ActiveSheet 'toto pracuje s aktuálním Listem
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDir & IIf(Right(sDir, 1) <> "\", "\", "") & MyStr & " - " & .Range("B4") & " - " & .Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
KONEC:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If Err.Number = 0 Then
MsgBox "Uloženo", vbInformation
Else
MsgBox "Nastala chyba !", vbCritical
End If
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "Pohledávky po splatnosti HS " & .Range("B4")
.Body = "Posíláme pohledávky po splatnosti pro HS " & .Range("B4")
.Attachments.Add (sDir & IIf(Right(sDir, 1) <> "\", "\", "") & MyStr & " - " & .Range("B4") & " - " & .Name & ".pdf")
'.Send 'or use .Display
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Subcitovat
Ono to nahlásí kritickou chybu a já pak nevím, kde je chyba?
Co tam má špatně? Pořadí?
Sub doPDF_bezCOPY_proHS_email()
Dim sDir As String
Dim MyDate, MyTime, MyStr, MyStr1
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
MyTime = Time
MyDate = Date
'MyStr1 = Format(MyTime, "hh-mm-ss")
MyStr = Format(MyDate, "yyyy-mm-dd") 'Rozhoduje pořadí, bere se ta poslední varianta, řádek
sDir = ThisWorkbook.Path & "\__pdfhs\"
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error GoTo KONEC
'With List2 'sem napíšeš list, který se má zpracovat
With ActiveSheet 'toto pracuje s aktuálním Listem
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sDir & IIf(Right(sDir, 1) <> "\", "\", "") & MyStr & " - " & .Range("B4") & " - " & .Name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
KONEC:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If Err.Number = 0 Then
MsgBox "Uloženo", vbInformation
Else
MsgBox "Nastala chyba !", vbCritical
End If
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "Pohledávky po splatnosti HS " & .Range("B4")
.Body = "Posíláme pohledávky po splatnosti pro HS " & .Range("B4")
.Attachments.Add (sDir & IIf(Right(sDir, 1) <> "\", "\", "") & MyStr & " - " & .Range("B4") & " - " & .Name & ".pdf")
'.Send 'or use .Display
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Subcitovat
Som teraz len na mobile...
Vyremujte riadok
On Error GoTo KONEC
Kde to zastaví?
Ta cesta "\__pdfhs\" existuje?
Čo obsahuje bunka B4?citovat
Vyremujte riadok
On Error GoTo KONEC
Kde to zastaví?
Ta cesta "\__pdfhs\" existuje?
Čo obsahuje bunka B4?citovat
Adresář existuje.
v buňce B4 je textová hodnota, např. "0002". Je to kód hospodářského střediska a proto je to použité, ta buňka i v názvu ukládaného souboru.
Omlouvám se, ale co je to vyremujte?
udělal jsem toto:
'On Error GoTo KONEC
Ono se to uloží, ale neotevře se okno Outlooku.citovat
v buňce B4 je textová hodnota, např. "0002". Je to kód hospodářského střediska a proto je to použité, ta buňka i v názvu ukládaného souboru.
Omlouvám se, ale co je to vyremujte?
udělal jsem toto:
'On Error GoTo KONEC
Ono se to uloží, ale neotevře se okno Outlooku.citovat
Pridané ošetrenie všetkých možných stavov a chýb, čo ma napadlo...
Příloha: 53277_export-pdf-pokus-bez-copy.zip (178kB, staženo 7x)
citovat53277_export-pdf-pokus-bez-copy.zip (178kB, staženo 7x)Změnil jsem ten účet na můj.
Napsal jsem moji email adresu:
něco@domena.cz
Po spuštění mi to dialogové okno napíše, že *.pdf OK, ale že nenalezen outlook účet.citovat
Napsal jsem moji email adresu:
něco@domena.cz
Po spuštění mi to dialogové okno napíše, že *.pdf OK, ale že nenalezen outlook účet.citovat
Dajte si tam dočasne toto makro na výpis zoznamu účtov.
Sub Vypis_Uctov_Outlooku()
Dim OutApp As Object, oUcet As Object
On Error Resume Next
Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
If OutApp Is Nothing Then Debug.Print "CHYBA" 'chybová správa o otvírání Outlooku
End If
On Error GoTo 0
For Each oUcet In OutApp.Session.Accounts 'výpis účtů
Debug.Print oUcet & "......." & oUcet.CurrentUser.Address
Next oUcet
Set OutApp = Nothing: Set oUcet = Nothing
End Sub
Zobrazte si okno Immediate (Ctrl+G), Potom spustite toto makro. V okne Immediate sa vypíše zoznam názvov kont a adries v Outlooku. Lebo názov konta nemusí byť emailová adresa. Názov konta môže byť "Ferko Mrkvička z firmy ABC s.r.o." a email má "ferko.mrkvicka@abc.com". No názov konta môže byť aj rovnaký ako mail. S čím som počítal. Možno to u Vás tak nie je. Ak to tak nie je, tak ten názov daného konta z okna Immediate skopírujte do makra do konštanty ODESILATEL_MAIL.
Const ODESILATEL_MAIL = "Ferko Mrkvička z firmy ABC s.r.o."
alebo konštantu nechajte tak a riadok
If oUcet = ODESILATEL_MAIL Then Exit Forzmeňte naIf oUcet.CurrentUser.Address = ODESILATEL_MAIL Then Exit For
u mňa všetko funguje, mám v Outlooku 8 účtov, a môžem si vybrať ktorý chcem. Ak účty premenujem tak potom musím urobiť jednu z vecí čo som teraz napísal, a zase všetko funguje. No problema.
EDIT:
A ešte ma napadlo. Zmeňte si
With ActiveSheetnaWith ThisWorkbook.ActiveSheet
Tuším predvčerom som to tu niekde vysvetľoval. Teraz sa mi to práve stalo, že pri debugovaní som sa prepol na iný zošit, a exportovalo mi aktívny list z toho iného zošitu. Pridanie ThisWorkbook aj toto riziko eliminuje
citovat
Sub Vypis_Uctov_Outlooku()
Dim OutApp As Object, oUcet As Object
On Error Resume Next
Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
If OutApp Is Nothing Then Debug.Print "CHYBA" 'chybová správa o otvírání Outlooku
End If
On Error GoTo 0
For Each oUcet In OutApp.Session.Accounts 'výpis účtů
Debug.Print oUcet & "......." & oUcet.CurrentUser.Address
Next oUcet
Set OutApp = Nothing: Set oUcet = Nothing
End Sub
Zobrazte si okno Immediate (Ctrl+G), Potom spustite toto makro. V okne Immediate sa vypíše zoznam názvov kont a adries v Outlooku. Lebo názov konta nemusí byť emailová adresa. Názov konta môže byť "Ferko Mrkvička z firmy ABC s.r.o." a email má "ferko.mrkvicka@abc.com". No názov konta môže byť aj rovnaký ako mail. S čím som počítal. Možno to u Vás tak nie je. Ak to tak nie je, tak ten názov daného konta z okna Immediate skopírujte do makra do konštanty ODESILATEL_MAIL.
Const ODESILATEL_MAIL = "Ferko Mrkvička z firmy ABC s.r.o."
alebo konštantu nechajte tak a riadok
If oUcet = ODESILATEL_MAIL Then Exit Forzmeňte naIf oUcet.CurrentUser.Address = ODESILATEL_MAIL Then Exit For
u mňa všetko funguje, mám v Outlooku 8 účtov, a môžem si vybrať ktorý chcem. Ak účty premenujem tak potom musím urobiť jednu z vecí čo som teraz napísal, a zase všetko funguje. No problema.
EDIT:
A ešte ma napadlo. Zmeňte si
With ActiveSheetnaWith ThisWorkbook.ActiveSheet
Tuším predvčerom som to tu niekde vysvetľoval. Teraz sa mi to práve stalo, že pri debugovaní som sa prepol na iný zošit, a exportovalo mi aktívny list z toho iného zošitu. Pridanie ThisWorkbook aj toto riziko eliminuje
citovatSuper, mám to opravené. Díky za pomoc.
Jsem si také opravil.
With ThisWorkbook.ActiveSheet
Ale přesto mám dotazy.
Dalo by se to nastavit tak, abych nemusel "editovat" toho ODESILATEL_MAIL?
A co mám změnit, aby se připravený email zobrazil, ten jeho dialog, aby to nezůstalo "skryté", neozbrazené?
A pak se chci zeptat.
teď to ukládám do adresáře __pdfhs
Kdybych si předpřipravil adresáře
__pdfhs0002
__pdfhs0003
a další podle čísla HS (hospodářské středisko).
Dalo by se nastavit, aby ta cesta k adresáři:
sDir = ThisWorkbook.Path & "\__pdfhs\"
byla automaticky doplněna ještě od hodnotu v buňce B4?
takže by se spojilo to:
__pdfhs a hodnota v buňce B4.
Ona ta hodnota v buňce B4 se používá při vytváření názvu souboru a tak by se mi příslušný vytvořený soubor uložil do adresáře toho HS.
Ještě jednou děkuji.
RAdekcitovat
Jsem si také opravil.
With ThisWorkbook.ActiveSheet
Ale přesto mám dotazy.
Dalo by se to nastavit tak, abych nemusel "editovat" toho ODESILATEL_MAIL?
A co mám změnit, aby se připravený email zobrazil, ten jeho dialog, aby to nezůstalo "skryté", neozbrazené?
A pak se chci zeptat.
teď to ukládám do adresáře __pdfhs
Kdybych si předpřipravil adresáře
__pdfhs0002
__pdfhs0003
a další podle čísla HS (hospodářské středisko).
Dalo by se nastavit, aby ta cesta k adresáři:
sDir = ThisWorkbook.Path & "\__pdfhs\"
byla automaticky doplněna ještě od hodnotu v buňce B4?
takže by se spojilo to:
__pdfhs a hodnota v buňce B4.
Ona ta hodnota v buňce B4 se používá při vytváření názvu souboru a tak by se mi příslušný vytvořený soubor uložil do adresáře toho HS.
Ještě jednou děkuji.
RAdekcitovat
Kdybych si předpřipravil adresáře
__pdfhs0002
__pdfhs0003
a další podle čísla HS (hospodářské středisko).
Úprava je jednoduchá. A žiadne adresáre si vytvárať nemusíte. Makro si ich vytvorí samo. Upravil som kód na danú štruktúru.
Dalo by se to nastavit tak, abych nemusel "editovat" toho ODESILATEL_MAIL?
Takže sa odošle pomocou predvoleného účtu v Outlooku. To je takisto jednoduché, vyremujeme všetko ohľadom oUcet (inak správne, "vyremovať" znamená dať apostrof - odstaviť kód :) )
A co mám změnit, aby se připravený email zobrazil, ten jeho dialog, aby to nezůstalo "skryté", neozbrazené?
no skúste, či som uhádol, čo tým myslíte...
Všetky 3 úpravy som zatiaľ urobil len vyremovaním a malou úpravou kódu. Ak to bude správne, vyremované časti odstrániť.
PS: A čo ten MAIL_ADRESAT? Odkiaľ sa má brať? Z nejakej bunky, alebo manuálne?
Příloha: 53289_export-pdf-pokus-bez-copy-2.zip (177kB, staženo 7x)
citovat53289_export-pdf-pokus-bez-copy-2.zip (177kB, staženo 7x)Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články