Brauchte erneut Hilfe für den schon bereits vorgefertigten Code eurerseits. Ich habe alles angepasst und funktioniert super. Danke hierfür.
Jetzt bräuchte ich die Option nach dem die Tabellenblätter anzeigt werden diese als PDF zu speichern. Meinen Code füge ich hinzu.
Wäre toll wenn mir jemand zeigen könnte warum die Datei nicht als PDF gespeichert wird.
'der Code ist nicht von mir!
On Error GoTo Fehlerbehandlung
Dim ctr As Control, arrBlätter() As String, i As Long
For Each ctr In Me.Controls
If TypeName(ctr) = "CheckBox" Then
If ctr Then
ReDim Preserve arrBlätter(i)
arrBlätter(i) = ctr.Caption
i = i + 1
End If
End If
Next ctr
Me.Hide
sheets(arrBlätter).PrintPreview
Me.Show
'hier folgt mein Code:
Dim strPfad As String, strname As String, strFilname As String
strPfad = "Y:\05\2021\" & Worksheets("41").Range("A102") \ ""
strname = Worksheets("41").Range("A100") & "_" & Date & ".pdf"
strFilename = strPfad & strname
strFilename = Application.GetSaveAsFilename(InitialFileName:=strFilename, FileFilter:="PDF files, *.pdf", Title:="PDF speichern")
If strFilename False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
Exit Sub
End If
Fehlerbehandlung:
Worksheets("41").Select
Range("D30").Select
ActiveWindow.SmallScroll Down:=-200
Dim wbk As Worksheet
For Each wbk In ActiveWorkbook.Worksheets
wbk.Protect ("123")
Next wbk
ActiveWorkbook.Protect Password:="1234"
Exit Sub
Wo liegt mein Fehler? Um Tipps und Hilfen wäre ich dankbar..