< návrat zpět

MS Excel

Téma: makro pro uložení do pdf - nechci přepsat stávaj rss

Zaslal/a voreljorel 27.9.2019 11:45

Dobrý den,
mám makro pro uložení do souboru pdf dle hodnot v buňkách. Potřeboval bych, aby mi makro ověřilo existenci pdf souboru pod stejným názvem a vyhodilo msgbox s tím, že soubor již existuje a zda chci soubor přepsat. Níže kód :-)
------
Sub Tisk_protokolu_do_PDF()

Application.ScreenUpdating = False

Sheets("Kovo - actual forms").Select

If Len(Dir(ThisWorkbook.Path & "\PDF\", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\PDF\"
End If

If Len(Dir(ThisWorkbook.Path & "\PDF\" & "Protokoly", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\PDF\" & "Protokoly"
End If

If Len(Dir(ThisWorkbook.Path & "\PDF\Protokoly\" & "Hotové", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\PDF\Protokoly\" & "Hotové"
End If

slozka = ThisWorkbook.Path & "\PDF\Protokoly\Hotové"
zakazka = Range("AK1").Text & "_" & Range("AL1").Text & " - " & Range("AJ3").Text
soubor = slozka & "\" & zakazka & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=soubor, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

Application.ScreenUpdating = True

End Sub
----------------

Děkuji moczapomoc :-)

Zaslat odpověď >
elninoslov(27.9.2019 12:29)#044410
elninoslov
Veď to otestujte cez Len(Dir()) tak ako testujete existenciu adresárov. Napr. :
Sub Tisk_protokolu_do_PDF()
Dim Soubor As String, Slozka As String, Zakazka As String, Rozhodnuti As Long

Slozka = ThisWorkbook.Path
If Len(Dir(Slozka & "\PDF", vbDirectory)) = 0 Then MkDir Slozka & "\PDF"
If Len(Dir(Slozka & "\PDF\Protokoly", vbDirectory)) = 0 Then MkDir Slozka & "\PDF\Protokoly"
If Len(Dir(Slozka & "\PDF\Protokoly\Hotové", vbDirectory)) = 0 Then MkDir Slozka & "\PDF\Protokoly\Hotové"

With ThisWorkbook.Worksheets("Kovo - actual forms")
Zakazka = .Range("AK1").Text & "_" & .Range("AL1").Text & " - " & .Range("AJ3").Text
Soubor = Slozka & "\PDF\Protokoly\Hotové\" & Zakazka

Rozhodnuti = vbYes
If Len(Dir(Soubor & ".pdf", vbNormal)) <> 0 Then
Rozhodnuti = MsgBox("Soubor PDF již existuje." & vbNewLine & "Přejete si ho prepsat ?" & vbNewLine & vbNewLine & Soubor & ".pdf" & vbNewLine & vbNewLine & _
"ANO - přepsat" & vbNewLine & _
"NE - uložit s číslem 2" & vbNewLine & _
"ZRUŠIT - zrušit operaci", vbQuestion + vbYesNoCancel, "Upozornění")
End If
If Rozhodnuti = vbCancel Then Exit Sub

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Soubor & IIf(Rozhodnuti = vbNo, "2", "") & ".pdf", _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End With
End Sub
Příloha: zip44410_zosit1.zip (20kB, staženo 36x)
citovat
voreljorel(27.9.2019 15:30)#044415
avatar
super děkuji :-)citovat

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