Roadrocker66
Gebruiker
- Lid geworden
- 7 mei 2009
- Berichten
- 104
Goedendag.
Ik wil graag een excelSheet opslaan, overschrijven of annuleren als Pdf file.
Alles gaat zo als het hoort zonder de de messagebox keuze opslaan, overschrijven of annuleren.
Als ik de functie wel wil gebruiken krijg ik bij Senario2 een foutmelding.
Kan iemand mij laten weten waarom de code niet werkt?
BvHD.
Ik wil graag een excelSheet opslaan, overschrijven of annuleren als Pdf file.
Alles gaat zo als het hoort zonder de de messagebox keuze opslaan, overschrijven of annuleren.
Als ik de functie wel wil gebruiken krijg ik bij Senario2 een foutmelding.
Kan iemand mij laten weten waarom de code niet werkt?
BvHD.
Code:
Sub Create_PDF_File()
'
' Create_PDF Macro
' Pdf Area in Preview Mode
'
' Sneltoets: Ctrl+Shift+F
Dim PdfNo As Long
Dim Dt As Date
Dim Amt As Currency
Dim PdfPath As String
Dim FName As String
Dim Nrow As Range
PdfNo = Range("K2")
Dt = Range("B2")
Amt = Range("I12")
PdfPath = "C:\Users\Jeen\Documenten\Persoonlijke_Documenten\Financien\"
FName = Range("J2") & "_" & PdfNo
If FName = "" Then
'Senerio 1 Duplicate File doesn't exist
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=PdfPath & FName
Else
mbox = MsgBox("Dit File bestaal al. Wilt u de file overschrijven?", vbYesNoCancel)
If mbox = vbYes Then
'Senerio 2 Overwrite the File - Without warnings
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, ignoreprintareas:=False, Filename:=PdfPath & FName
Application.DisplayAlerts = True
ElseIf mbox = vbNo Then
'Senerio 3 Do Nothing
Else
'Senerio 4 Cancel on the Message box exits sub
Exit Sub
End If
End If
Set Nrow = Blad2.Range("a1048576").End(xlUp).Offset(1, 0)
Nrow = PdfNo
Nrow.Offset(0, 1) = Dt
Nrow.Offset(0, 2) = Amt
Blad2.Hyperlinks.Add anchor:=Nrow.Offset(0, 3), Address:=PdfPath & FName & ".pdf"
End SubBijlagen
Laatst bewerkt:
