Goedemorgen,
Dit is een vervolg van een bepaald UserForm Printen.
Om een bepaald UserForm te printen zijn we uit gekomen (zie draadje een bepaald UserForm Printen)
Aansluitend om van ditzelfde UserForm een PDF te maken zijn we uiteindelijk ook uitgekomen, maar
er doet zich wel een raar fenomeen voor.
Als ik een snapshot maak van het UserForm en deze vervolgens wil omzetten naar een PDF, komt er iedere keer
het snapshot van vorige keer uit.
Als ik opstart en een 1e maal een snapshot maak, maakt hij wel het PDF, maar daar staat dus niets in.
Bij de 2e keer, als je hetzelfde UserForm weer een snapshot van maakt komt er wel het goede uit.
Maar eigenlijk is dit het snapshot van vorige keer.
Zal de macro neer zetten en mocht iemand een idee hebben, gaarne.
Doe er ook het vb-tje bij waarmee ik bovenstaande gemaakt hebt.
Let op de 1e keer dat je het maakt heeft ie dus niets gemaakt, omdat er nog geen vorige snapshot was.
Probleem zit hem in het geheugen??
Vr. Gr.
Dutch
Dit is een vervolg van een bepaald UserForm Printen.
Om een bepaald UserForm te printen zijn we uit gekomen (zie draadje een bepaald UserForm Printen)
Aansluitend om van ditzelfde UserForm een PDF te maken zijn we uiteindelijk ook uitgekomen, maar
er doet zich wel een raar fenomeen voor.
Als ik een snapshot maak van het UserForm en deze vervolgens wil omzetten naar een PDF, komt er iedere keer
het snapshot van vorige keer uit.
Als ik opstart en een 1e maal een snapshot maak, maakt hij wel het PDF, maar daar staat dus niets in.
Bij de 2e keer, als je hetzelfde UserForm weer een snapshot van maakt komt er wel het goede uit.
Maar eigenlijk is dit het snapshot van vorige keer.
Zal de macro neer zetten en mocht iemand een idee hebben, gaarne.
Code:
Private Sub PDFUserFormBut_Click()
Dim hWnd As Long, xlTypePDF, pdfjob As Object, sPDFName As String, ePDFPath As String, Bestand As String, txt As String, fName As String, wsTemp As Worksheet
Sheets("Behang").Unprotect ' haalt de beveiliging van het blad
hWnd = FindWindow("ThunderDFrame", PAA_APLFrame.Caption)
SetForegroundWindow hWnd
keybd_event VK_SNAPSHOT, 1, 0, 0 ' maakt een printscreen van dit Userform
DoEvents
With Worksheets("Behang").ChartObjects.Add(140, 35, PAA_APLFrame.Width + 120, PAA_APLFrame.Height + 50)
.Chart.ChartArea.Border.LineStyle = xlNone
.Activate
.Chart.Paste
End With
Set wsTemp = Sheets("Behang")
With wsTemp
With .PageSetup ' Height * 0,7 kan je aanpassen kleiner of groter
.LeftMargin = Application.InchesToPoints(0.3) ' small margins
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.3)
.BottomMargin = Application.InchesToPoints(0.3)
.Orientation = xlLandscape ' most important setting here
End With
End With
fName = ActiveWorkbook.Worksheets("Control").Range("AC73") & ActiveWorkbook.Worksheets("Control").Range("D20") & Format(ActiveWorkbook.Worksheets("Control").Range("E16"), "mmmm") & ".xls" ' Path en Naam + extensie
MijnNaam = fName
sPDFName = IIf(MijnNaam = "", "GeenNaam", MijnNaam) & ".xls" ' sPDFNaame = Als MijnNaam = "" dan "GeenNaam" anders MijnNaam & xls
ePDFPath = ThisWorkbook.Sheets("Control").Range("Q73 ") ' ePath is het path voor het opslaan van PDF-AAA
Bestand = ePDFPath & sPDFName ' Bestand = Path + sPDFName
Application.DisplayAlerts = False
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator") ' objectverwijzing naar pdfjob
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then ' als pdfjob niet wil starten
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator" ' https://www.google.nl/search?source=hp&ei=ZggfXYzSKdL5kwW0lLeoBQ&q=.cOption+%28%22UseAutoSave%22%29+-+1+++&oq=.cOption+%28%22UseAutoSave%22%29+-+1+++&gs_l=psy-ab.3..0i22i10i30.11086.11086..17811...0.0..0.98.98.1......0....2j1..gws-wiz.....0.pX0AorYfMgU
Exit Sub ' https://www.cimaware.com/expert-zone/printing-worksheets-to-a-pdf-file-using-early-binding
End If
.cOption("UseAutoSave") = 1 ' gebruik Autosave aan
.cOption("UseAutosaveDirectory") = 1 ' gebruik Autosave Directory aan
.cOption("AutosaveDirectory") = ePDFPath ' AutosaveDirectory = SPDFPath
.cOption("AutosaveFilename") = sPDFName ' AutosaveFileName = SPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache '
End With
ActiveSheet.Range("D4:R45").PrintOut copies:=1, ActivePrinter:="PDFCreator" ' maakt een PDF-file
Do Until pdfjob.cCountOfPrintjobs = 1 ' wait until the print job has entered the print queue
DoEvents
With Worksheets("Behang").ChartObjects
.Delete ' haalt grafisch Userform weg van wb Behang
MsgBox (" <<<<><<<<<<<<<<<<< Message Box >>>>>>>>>>>>><>>>>" & vbNewLine & vbNewLine & "Er is een PDF gemaakt van het UserForm, Deze is terug te vinden op:" & vbNewLine & vbNewLine & ActiveWorkbook.Worksheets("Control").Range("Q73") & vbNewLine & vbNewLine & "Onder de naam: " & ActiveWorkbook.Worksheets("Control").Range("AC73") & " met 'jaar en maand'" & vbNewLine & vbNewLine & vbNewLine & "_______________________________________________________ Geef OK & Doorgaan")
End With
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0 ' wait until PDF creator is finished then release the objects
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
Sheets("Behang").Protect DrawingObjects:=True, contents:=True, Scenarios:=True ' beveilig blad weer
PAA_APLFrame.Hide
End SubDoe er ook het vb-tje bij waarmee ik bovenstaande gemaakt hebt.
Let op de 1e keer dat je het maakt heeft ie dus niets gemaakt, omdat er nog geen vorige snapshot was.
Probleem zit hem in het geheugen??
Vr. Gr.
Dutch
