Saving an Excel Range as Word and PDF document

[StevieMP]

Hi There,
I have some VBA code which takes a range within an Excel spreadsheet and adds the range into a Word document and then prompts the user for a name and destination to save to and that works well. At the same time I save the now newly created Word document I also save it as a pdf document which again prompts the user for a name and destination to save to. I can see both files created in the destination I selected, however when I open the pdf file I get the following message:
"Adobe Acrobat could not open 'Test1.PDF' because it is either not a supported file type or because the file has been damaged (for example, it was sent as an email attachment and wasn't correctly decoded).
To create an Adobe PDF document, go to the source application. Then print the document to Adobe PDF."

Is there some VBA code to use to circumvent me reopening the word document and resaving as a PDF?
Can someone assist please?
Here is my code:

Sub ExcelWordToPDF()

Dim objWord As Object
Dim objDoc As Object
Dim mytable As Object
Dim filename As String
Dim fname As String, fname2 As String, fPath As String, fPath2 As String

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

ThisWorkbook.Worksheets("Test").Range("A1:D150").Copy

Set objDoc = objWord.documents.Add

With objDoc.Range.Characters.Last
.PasteExcelTable False, False, False
With .tables(1)
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
End With
.InsertAfter Chr(12) 'vbCr
End With


fname = InputBox("Enter the file name to use, including file extension.")

fPath = Application.GetSaveAsFilename(fname, "Word Files (*.docx), *.docx")
fPath2 = Application.GetSaveAsFilename(fname2, "PDF Files (*.pdf), *.pdf")

objWord.activedocument.SaveAs fPath
objWord.activedocument.SaveAs2 fPath2

objWord.activedocument.Close


End Sub

 

[Trevor G]

A suggestion is that you could record a macro in Word and open a test word doc and then save it as pdf that would give you the code that you could adapt. If you need an example let me know.

 

[StevieMP]

A suggestion is that you could record a macro in Word and open a test word doc and then save it as pdf that would give you the code that you could adapt. If you need an example let me know.

Thank You Trevor,

I've recorded both Excel & Word code to save as a pdf, but not sure where in my code to add it.

Also, I want to be able to still prompt the User to save to whatever location they prefer. Does that mean the text I've highlighted in red needs to be taken out?

So for example :

Excel code to Save as PDF :
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
"C:\Test Spreado.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Word code to Save as PDF:
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"C:\Test1.pdf", ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

 

[Trevor G]

Hi StevieMP

I have adjusted and tested the original code from your thread and have created the following which I hope will provide a solution for you. Basically what I have added is to activate the document once created and then save as pdf. When I have used Explorer to find the document and PDF document once I look to open it, it no longer activates the browser.

I hope this helps. If you use the VBA feature on the toolbar it makes it easier to read your code.

Sub ExcelWordToPDF()

Dim objWord As Object
Dim objDoc As Object
Dim mytable As Object
Dim filename As String
Dim fname As String, fPath As String ' I have not used the next set, fname2 As String,fPath2 As String

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

ThisWorkbook.Worksheets("Test").Range("A1:D15").Copy 'Remember to change the range back to yours

Set objDoc = objWord.Documents.Add

With objDoc.Range.Characters.Last
.PasteExcelTable False, False, False
With .Tables(1)
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
End With
.InsertAfter Chr(12) 'vbCr
End With

fname = InputBox("Enter the file name to use, including file extension.")

fPath = Application.GetSaveAsFilename(fname, "Word Files (*.docx), *.docx")
'I have commented the line below as I have commented out the declaration
'fPath2 = Application.GetSaveAsFilename(fname2, "PDF Files (*.pdf), *.pdf")

objWord.activedocument.SaveAs fPath
objWord.Activate
objDoc.SaveAs2 Replace(fPath, "docx", "pdf"), 17

objDoc.Close False
objWord.Quit
Set objWord = Nothing


End Sub

 

[StevieMP]

Hi StevieMP

I have adjusted and tested the original code from your thread and have created the following which I hope will provide a solution for you. Basically what I have added is to activate the document once created and then save as pdf. When I have used Explorer to find the document and PDF document once I look to open it, it no longer activates the browser.

I hope this helps. If you use the VBA feature on the toolbar it makes it easier to read your code.

Sub ExcelWordToPDF()

Dim objWord As Object
Dim objDoc As Object
Dim mytable As Object
Dim filename As String
Dim fname As String, fPath As String ' I have not used the next set, fname2 As String,fPath2 As String

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

ThisWorkbook.Worksheets("Test").Range("A1:D15").Copy 'Remember to change the range back to yours

Set objDoc = objWord.Documents.Add

With objDoc.Range.Characters.Last
.PasteExcelTable False, False, False
With .Tables(1)
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
End With
.InsertAfter Chr(12) 'vbCr
End With

fname = InputBox("Enter the file name to use, including file extension.")

fPath = Application.GetSaveAsFilename(fname, "Word Files (*.docx), *.docx")
'I have commented the line below as I have commented out the declaration
'fPath2 = Application.GetSaveAsFilename(fname2, "PDF Files (*.pdf), *.pdf")

objWord.activedocument.SaveAs fPath
objWord.Activate
objDoc.SaveAs2 Replace(fPath, "docx", "pdf"), 17

objDoc.Close False
objWord.Quit
Set objWord = Nothing


End Sub

Hi Trevor,
Thank you so much for your help.
That works perfectly and I've learnt something new.
Really appreciate your help.
Steve

 

[Trevor G]

Pleased to read you have a working solution Steve.

Thank you for letting me know.