PDF direkt speichern ohne Nachfrage
17.03.2022 21:44:18
Roger
Public Sub RECHNUNG_PDF_erstellen_und_Übertragen_auf_Rechnung()
Dim vntFile As Variant
vntFile = Application.GetSaveAsFilename(Range("AA1").Value & "\" & ActiveSheet.Name & _
Range("C1").Value & ".pdf", "PDF Dateien (*.pdf), *.pdf", Title:="Als PDF Speichern")
If vntFile False Then
ActiveSheet.Range("B2:G66").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vntFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
vntFile = Application.GetSaveAsFilename(Range("BA1").Value & "\" & ActiveSheet.Name & _
Range("S1").Value & ".pdf", "PDF Dateien (*.pdf), *.pdf", Title:="Als PDF Speichern")
If vntFile False Then
ActiveSheet.Range("S1:T30").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vntFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=Fals, _
OpenAfterPublish:=False
End If
Dim raFund As Range
With Sheets(4)
.Unprotect Password:=""
.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("D1").Value = Date & ", " & Format(Time, "hh:mm:ss")
Set raFund = .Columns(2).Find(what:=Sheets(3).Range("D5"), LookIn:=xlValues, _
lookat:=xlWhole)
If Not raFund Is Nothing Then
raFund.Offset(, 2) = Sheets(3).Range("L15")
If vntFile False Then .Hyperlinks.Add Anchor:=raFund.Offset(, 2), _
Address:=vntFile, TextToDisplay:=Sheets(3).Range("L15").Text
End If
.Protect Password:=""
End With
Set raFund = Nothing
Sheets(3).Range("G1").ClearContents
Range("U1").Select
End If
End Sub
Anzeige