Adobe PDFMakerForOffice
14.11.2023 07:52:35
teleman65
habe früher ein tolles Makro zum Drucken (AdobePDFMaker) gehabt. Nun haben wir kein Adobe mehr sondern FoxitPDF.
Hier ein Auszug aus dem Makro.
Sub Convert_SpeichernToPDF_SM_NEU()
Dim pmkr As AdobePDFMakerForOffice.PDFMaker
Dim stng As AdobePDFMakerForOffice.ISettings
Dim dialog As Object
Dim pfad As String
Dim name As String
Dim datei As String
Dim wks As Worksheet
pfad = "C:\Users\______\Desktop\"
name1 = "Protokoll "
name2 = "Checkliste "
name3 = "Baubeschreibung "
name4 = "Materialliste_S "
name5 = "Qualitätsaufzeichnung "
datei = ActiveSheet.Range("B2")
With Worksheets("Checkliste")
MkDir "C:\Users\______\Desktop\SM" & .Range("B2") & "-" & .Range("L2")
'Ordner auf dem Desktop erstellen
End With
Sheets("Checkliste").Select
Range("A25") = "Ü-Wege" & Range("G5") & " " & Range("L2") & " SMNr. " & Range("B2")
'Beschreiben der Zelle A25 (Bestelltext)
Range("A25:Z25").Select
Selection.Copy
Sheets("eMail_Montage System").Select
Range("AN2").Select
ActiveSheet.Paste
Sheets("eMail_Montage System").Activate
ActiveSheet.Range("E23").Select
'Bestelltext
ActiveWorkbook.SaveAs Filename:=pfad & name1 & datei & ".xlsm"
'speichern der Datei
ActiveWorkbook.SaveAs Filename:=pfad & "1. " & name2 & datei & ".xlsm"
'speichern der Datei
Sheets(Array("Checkliste")).Select
Sheets("Checkliste").PageSetup.PrintArea = "$A$1:$Z$42"
Set pmkr = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr = a.Object
Exit For
End If
Next
If pmkr Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
pmkr.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.ConvertAllPages = True
stng.AddTags = False
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
stng.PromptForSheetSelection = False
stng.FitToOnePage = False
pmkr.CreatePDFEx stng, 0
'drucke der Datei in PDF
ActiveWorkbook.SaveAs Filename:=pfad & "2. " & name3 & datei & ".xlsm"
'speichern der Datei
Sheets(Array("Baubeschreibung")).Select
Sheets("Baubeschreibung").PageSetup.PrintArea = "$A$1:$AC$63"
Set pmkr = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr = a.Object
Exit For
End If
Next
If pmkr Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
pmkr.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.ConvertAllPages = True
stng.AddTags = False
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
stng.PromptForSheetSelection = False
stng.FitToOnePage = False
pmkr.CreatePDFEx stng, 0
'drucke der Datei in PDF
ActiveWorkbook.SaveAs Filename:=pfad & "3. " & name4 & datei & ".xlsm"
'speichern der Datei
Sheets(Array("Materialliste_S")).Select
'Sheets("Materialliste_S").PageSetup.PrintArea = "$A$1:$AP$35"
Set pmkr = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr = a.Object
Exit For
End If
Next
If pmkr Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
pmkr.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.ConvertAllPages = True
stng.AddTags = False
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
stng.PromptForSheetSelection = False
stng.FitToOnePage = False
pmkr.CreatePDFEx stng, 0
'drucke der Datei in PDF
ActiveWorkbook.SaveAs Filename:=pfad & "4. " & name5 & datei & ".xlsm"
'speichern der Datei
Sheets(Array("Qualitätsaufzeichnung")).Select
Set pmkr = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr = a.Object
Exit For
End If
Next
If pmkr Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
pmkr.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.ConvertAllPages = True
stng.AddTags = False
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
stng.PromptForSheetSelection = False
stng.FitToOnePage = False
pmkr.CreatePDFEx stng, 0
'drucke der Datei in PDF
Set pmkr = Nothing
Set stng = Nothing
ActiveWorkbook.Close savechanges:=False
strVariable = pfad & "1. " & name2 & datei & ".xlsm"
Kill strVariable
strVariable = pfad & "2. " & name3 & datei & ".xlsm"
Kill strVariable
strVariable = pfad & "3. " & name4 & datei & ".xlsm"
Kill strVariable
strVariable = pfad & "4. " & name5 & datei & ".xlsm"
Kill strVariable
'löschen der Datei
Application.Quit
End Sub
Hier nun meine Frage?
Gibt es für FoxitPDF auch ein Makro zum Drucken. (nicht über dem Makro aufzeichnen Icon)
Danke schon mals.