AW: Dateiname auffüllen
16.12.2020 16:31:57
Ulrich
Hallo Nepumuk,
sorry,
mit dem Code speichere ich ja als PDF und als XLSM
Ich habe den jetzt wie folgt vergewaltigt, aber es kommt ein Fehler (Anhang)
Darunter setze ich noch einmal den Code ohne die 3-Stellige Ergänzung, der funktioniert soweit.
Option Explicit
Public gblnCancel As Boolean
Sub Speichern_Makro()
' Speichern Makro
Dim objCell As Range
Dim objTargetWorkbook As Workbook
Dim objTargetWorksheet As Worksheet, objSourceWorksheet As Worksheet
Dim objName As Name
Dim lngEmptyCells As Long
Dim strPath As String
gblnCancel = False
Call objTargetWorkbook.SaveAs(Filename:=strPath & Range("M1").Value & _
Format$(Range("H1").Value, "000") & ".xlsm", FileFormat:=xlOpenXMLWorkbook)
ThisWorkbook.Sheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Range("M1").Value & _
Format$(Range("H1").Value, "000") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
If Not gblnCancel Then
Workbooks.Open ThisWorkbook.Path & "\Protokoll.xlsm"
Dim WB As Workbook
For Each WB In Workbooks
If WB.Name ThisWorkbook.Name And _
WB.Name "Protokoll.xlsm" Then
WB.Close SaveChanges:=True
End If
Next WB
ThisWorkbook.Close SaveChanges:=True
End If
End Sub
Option Explicit
Public gblnCancel As Boolean
Sub Speichern_Makro()
' Speichern Makro
gblnCancel = False
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("M1").Value & _
Range("H1").Value & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
ThisWorkbook.Sheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Range("M1").Value & _
Range("H1").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
If Not gblnCancel Then
Workbooks.Open ThisWorkbook.Path & "\Protokoll.xlsm"
Dim WB As Workbook
For Each WB In Workbooks
If WB.Name ThisWorkbook.Name And _
WB.Name "Protokoll.xlsm" Then
WB.Close SaveChanges:=True
End If
Next WB
ThisWorkbook.Close SaveChanges:=True
End If
End Sub
