Convert Sheet to PDF missing images - excel

I am using this code to convert sheet to pdf file.I must mention that my Excel Sheet also contains images in each cells on a Column.
Sub SheetToPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = "test"
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If
'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "Successfully created PDF file: " _
& vbCrLf _
& strPathFile
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file :("
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
The problem is that the PDF file is missing images (only last 2 pages copied the images successfully)
Is there any code to help me copy all images from the excel sheet to PDF file?
Thank you very much!

Related

Range variable not working in VBA for ExportAsFixedFormat

I am setting a worksheet name as wsDR and a named range on that worksheet called "daily_report" as rngDR to use in the ExportAsFixedFormat. However, it does not seem to work when combined in the code i.e. wsDR.rngDR.ExportAsFixedFormat _ 'rest of the code.
When I replace rngDR with range("daily_report") the code, wsDR.range("daily_report").ExportAsFixedFormat the sub works but when I simply use rngDR it doesn't work.
Sub PDFProductionReport()
'PDF of current worksheet
Dim wsDR As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim reportName As String
Dim strPathFile As String
Dim myFile As Variant
Dim rngDR As Range
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsDR = Sheets("Daily Report")
Set rngDR = Range("daily_report")
strTime = Format(Now(), "yyyymmdd") '_hhmm")
'get active workbook folder, if saved
strPath = Sheets("Library").Range("N11").Value
If strPath = "" Then
strPath = wbA.Path 'Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
reportName = "Production Report" 'Title of the report change here
strName = Replace(reportName, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsDR.rngDR.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

Change PDF Title when exporting

I have a nice working PDF export VBA that I use to export a sheet in Excel.
The problem is that the title of the Workbook also is the title of the exported PDF.
I cannot seem to change the title upon export and I cannot find a working solution for this.
The titlename has to be dynamic as this will change for each export.
The filename can be different from titlename.
Image found on internet shows the difference. It is the title property that I want to change.
My export code shown below.
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
Dim ary
Dim a As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\Monthly reports\"
strName = wsA.Range("V4").Value & "-" & wsA.Range("W4").Value & " " & wsA.Range("C5").Value _
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If
'Select sheets to use
ary = Array(Sheet5.Name)
For Each a In ary
Sheets(a).Move after:=Sheets(Sheets.Count)
Next a
ThisWorkbook.Sheets(ary).Select
'export to PDF in current folder
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler

Excel VBA Print w Automated File Name and Location using Range.ExportAsFixedFormat

https://www.contextures.com/excelvbapdf.html
The following is perfect, but it prints the entire sheet.
full thread
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
but I'm having trouble with this
'export to PDF if a folder was selected
If myFile <> "False" Then
` wsA.ExportAsFixedFormat
Type:=xlTypePDF,
Filename:=myFile,
Quality:=xlQualityStandard,
IncludeDocProperties:=True,
IgnorePrintAreas:=False,
OpenAfterPublish:=False`
The only thing I'm trying to accomplish is print a range (Preferably named) in lieu of the entire sheet. I created dims and set a range to use in lieu of the 'wsA' Sheet and it is bugging.
Dim rnG As Range
Set rnG = Range("Y1:AG46")
rnG.ExportAsFixedFormat _
Are the only lines that I've added. It'll work as I want it, but intermittently and I've got no idea why. It bugs in yellow the entire ExportFileAsFixedFormat subtext and points to not recognizing the specified Range.
I suspect this is because you are not qualifying the range. Try
Set rnG = wsA.Range("Y1:AG46")
Without qualification works correctly only if wsA is the active sheet.

Exporting excel worksheet to CSV via VBA with formula results shown

I have an excel workbook with multiple sheets, i'm trying to export a particular sheet as a CSV file and save it to the users desktop without impacting the original. Everything seems to work, however the file is coming out as a PDF, any ideas? Code is below:
Sub CSVSagePricelist_Click()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim TempWB As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Sheet8
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
If strPath = "" Then
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for saving file
strFile = "INT-ONLY-SAGE-PRICELIST" & "_" & Sheet16.Range("C17").Text & "_" & Sheet16.Range("B2").Text & ".csv"
strPathFile = strPath & strFile
'use can enter name and
'select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="CSV (Comma delimited) (*.csv), *.csv", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlCSV, _
Filename:=myFile
'confirmation message with file info
MsgBox "Sage pricebook CSV created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create CSV file"
Resume exitHandler
End Sub
Thanks,
Nick
Following code lines / code blocks are needed to corrected. Also you should include Option Explicit in the beginning of code so that undeclared variables are easily identified.
A.)
Set wsA = Sheet8
Will give Compiler error. Variable not defined. It should be changed to
Set wsA = Sheets("Sheet8")
Similarly
strFile = "INT-ONLY-SAGE-PRICELIST" & "_" & Sheet16.Range("C17").Text & "_" & Sheet16.Range("B2").Text & ".csv"
strPathFile = strPath & strFile
It should be changed to
strFile = "INT-ONLY-SAGE-PRICELIST" & "_" & Sheets("Sheet16").Range("C17").Text & "_" & Sheets("Sheet16").Range("B2").Text & ".csv"
strPathFile = strPath & strFile
B.) Block of code for saving as pdf file has incorrect syntax.
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlCSV, _
Filename:=myFile
'confirmation message with file info
MsgBox "Sage pricebook CSV created: " _
& vbCrLf _
& myFile
End If
Needs to be Changed to
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
With these changes your final code should work fine.
Option Explicit
Sub CSVSagePricelist_Click()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim TempWB As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Sheets("Sheet8")
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
If strPath = "" Then
strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for saving file
strFile = "INT-ONLY-SAGE-PRICELIST" & "_" & Sheets("Sheet16").Range("C17").Text & "_" & Sheets("Sheet16").Range("B2").Text & ".csv"
strPathFile = strPath & strFile
'use can enter name and
'select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="CSV (Comma delimited) (*.csv), *.csv", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create CSV file"
Resume exitHandler
End Sub

Loop through DV list and print all data selections to one pdf file

I have a vba excel to pdf code but I am unsure how to loop it through a data validation list. The data validation list is a collection of player names with each selection within the list interacting with vlookup's on the excel sheet. This means that each selection will result in different data pulled onto the sheet. Is there a way to loop and print each individual data selected sheet to a PDF but have all PDF sheets in a single file? The dvCell is located in cell C8 of sheet "Gym Weekly Template".
Below is the code I currently have:
Sub PDFActiveSheet()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Gym Weekly Template")
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Much appreciated if you can help!

Resources