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.
Anzeige