Hi,
I was wondering if you could help. I have looked to your code for an earlier version of PDF creator. Currently this is for Excel 2010 and the newest version of PDF Creator 1.6.0
Goal:
Print an entire workbook in excel as a PDF - to generate an archived report - using button within the spreadsheet.
It must include all OLE objects inserted in the last sheet (These are Inserted as Word Documents and displayed as icons, and the random picture -.jpg- every now and again)
I am not a programmer, so the following code may be entirely wrong. Except for what i have used from other posts of course.
I do hope you can have a look at it and shed some light in a solution.
Problems:
- At points PDF creator gets caught in the DO loops.
- OLE objects are not listed before collection
The process of sending each sheet and OLE object to the collection list in PDF creator can be done manually, so there must be a way to automate this process. Please help.
I was wondering if you could help. I have looked to your code for an earlier version of PDF creator. Currently this is for Excel 2010 and the newest version of PDF Creator 1.6.0
Goal:
Print an entire workbook in excel as a PDF - to generate an archived report - using button within the spreadsheet.
It must include all OLE objects inserted in the last sheet (These are Inserted as Word Documents and displayed as icons, and the random picture -.jpg- every now and again)
I am not a programmer, so the following code may be entirely wrong. Except for what i have used from other posts of course.
I do hope you can have a look at it and shed some light in a solution.
Problems:
- At points PDF creator gets caught in the DO loops.
- OLE objects are not listed before collection
The process of sending each sheet and OLE object to the collection list in PDF creator can be done manually, so there must be a way to automate this process. Please help.
Code:
'Called from the button click
Private Sub OLEToPDF()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim bRestart As Boolean
Dim i As Integer
Dim ObjList As Integer ' Variable ObjList stores a count of all embedded objects.
Sheets("OLE OBJECTS SHEET NAME HERE").Select 'On this Worksheet are the OLEObjects
ObjList = Sheets("OLE OBJECTS SHEET NAME HERE").OLEObjects.Count
'/// Change the output file name here! ///
sPDFName = "A.pdf" <<<< THIS CAN BE THE WORKBOOK NAME - tried ActiveWorkbook.Name
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
'Activate error handling and turn off screen updates
On Error GoTo EarlyExit
Application.ScreenUpdating = False
Set pdfjob = New PDFCreator.clsPDFCreator
'Check if PDFCreator is already running and attempt to kill the process if so
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'PDF Creator is already running. Kill the existing process
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False
'Assign settings for PDF job
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Delete the PDF if it already exists
If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)
'Print the document to PDF
'************ <<<<<<<<< HERE I ATTEMPT TO SEARCH ALL THE OLE OBJECTS IN THE LAST SHEET TO PRINT BEFORE COLLECTION
' Increments the counter variable 'i' in a loop.
For i = 1 To ObjList
'Selects the shape.
Sheets("OLE OBJECTS SHEET NAME HERE").OLEObjects(i).Select
Selection.Verb Verb:=xlPrimary
' Makes object active.
Sheets("OLE OBJECTS SHEET NAME HERE").OLEObjects(i).Activate
Sheets("OLE OBJECTS SHEET NAME HERE").OLEObjects(i).PrintObject = True
Set WordApp = GetObject(, "Word.Application")
WordApp.Visible = False
Word.App.ActivePrinter = "PDFCreator"
WordApp.ActiveDocument.PrintOut '<<<PRINT PROCESS OLE DOCUMENT, SEND TO PDF COLLECTION
Next
WordApp.Quit
'****************************************
'ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until the file shows up before closing PDF Creator
Do
DoEvents
Loop Until Dir(sPDFPath & sPDFName) = sPDFName
Cleanup:
'Release objects and terminate PDFCreator
Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
EarlyExit:
'Inform user of error, and go to cleanup section
MsgBox "There was an error encountered. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup
End Sub