PDA

View Full Version : When PrintView button is clicked open the invoice in PDF format



lapot
11-05-2014, 03:40 AM
Dear all

My attached excel sheet has list of invoices on sheet (invoice) - third sheet , Column B has invoice numbers and Colum E has hyperlinks which are coming from the SQL server, these hyperlinks to open the invoices in WORD format;

This is the location of the one of the invoice "\\svr-storage3\Accounts_Data\Docs\H\H\A\HHA6\62\Bill ref 223615_458254_1.doc"

I have a PrintView Command Button, when it is clicked it opens the invoices in Word format.

My question is , Is there a way when the PrintView Button is clicked , it opens the invoices in PDF format rather than Word format?

Here is my existing code.


Private Sub PrintView_Click()
Sheets("invoice").Select
Dim fnd As Range
With Range("B:B")
.NumberFormat = "0"
.Value = .Value
End With
Set fnd = Range("B:B").Find(TextBox5.Value, lookat:=xlWhole)
If Not fnd Is Nothing Then
Unload Me
ThisWorkbook.FollowHyperlink (fnd.Offset(, 3).Value)
Else: MsgBox "Number not found!"
End If
UserForm1.Show
End Sub

Kenneth Hobs
11-05-2014, 01:52 PM
The answer is it depends. Does the PDF file exist or does it need to be created first? IF the former, it is just a matter of using Replace() to replace the .doc with .pdf. I would recommend using something like Dir() to confirm if the file exists or not though. Of course if your file extensions could be doc or docx, two Replace()'s may be needed or a more robust method to create the proper path.

lapot
11-05-2014, 03:12 PM
The answer is it depends. Does the PDF file exist or does it need to be created first? IF the former, it is just a matter of using Replace() to replace the .doc with .pdf. I would recommend using something like Dir() to confirm if the file exists or not though. Of course if your file extensions could be doc or docx, two Replace()'s may be needed or a more robust method to create the proper path.

Thank you for your reply.

PDF doesnt exist. The invoices exist in Word format in the server. The server addreses are hyperlink on column E on the invoice sheet. When the printview buton is clicked it matches the invoice number in the textbox5 then matches the number in column B which activates the hyperlink opposite.

If you can help me on this I really appreciate.

Kenneth Hobs
11-05-2014, 03:27 PM
Then an MSword PrintTo method would be needed which can slow things a bit. If you have Adobe Acrobat, not the reader, a faster solution may be possible. If I get time tonight, I will wipe out an MSWord example.

lapot
11-06-2014, 01:17 AM
Then an MSword PrintTo method would be needed which can slow things a bit. If you have Adobe Acrobat, not the reader, a faster solution may be possible. If I get time tonight, I will wipe out an MSWord example.

I will be very greatful if you could

regards

Kenneth Hobs
11-06-2014, 07:52 AM
The MakeWordPDFFile() routine has some unneeded variables. I originally coded it using a late binding method where those Word constant values are needed. Since I later decided to use an early binding method and added the Word object, those were already defined. It doesn't hurt anything to leave them as is.

Replace your button's sub with this one:

Private Sub PrintView_Click() Dim r As Range, fnd As Range, fn As String, fnPDF As String

Set r = Worksheets("invoice").Range("B2", _
Worksheets("invoice").Range("B" & Rows.Count).End(xlUp))
With r
.NumberFormat = "0"
.Value = .Value
Set fnd = .Find(TextBox5.Value, lookat:=xlWhole)
End With

If Not fnd Is Nothing Then
Unload Me
fn = fnd.Offset(, 3).Value
fnPDF = TempPDF(fn)
MakeWordPDFFile fn, fnPDF
ThisWorkbook.FollowHyperlink fnPDF
Else: MsgBox "Number not found!"
End If

UserForm1.Show
End Sub

Be sure to add the reference to the MSWord object as commented. In a module:

Function GetBaseName(Filespec As String) Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
GetBaseName = FSO.GetBaseName(Filespec)
End Function


Function TempPDF(aDrivePathFilenameExtension As String) As String
TempPDF = Environ("temp") & "\" & GetBaseName(aDrivePathFilenameExtension) & ".pdf"
End Function


'Requires Tools > References > Microsoft Word 14.0 Object Library
Sub MakeWordPDFFile(sMSWordFilename As String, sOutputFilename As String)
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim wdExportFormatPDF As Integer, wdExportOptimizeForPrint As Integer
Dim wdExportAllDocument As Integer, wdExportDocumentContent As Integer
Dim wdExportCreateNoBookmarks As Integer

If Not CreateObject("Scripting.FileSystemObject").FileExists(sMSWordFilename) Then _
Exit Sub

On Error GoTo errorHandler
Set wdApp = New Word.Application
With wdApp
Set wdDoc = .Documents.Open(sMSWordFilename)
.Visible = False
End With

If CreateObject("Scripting.FileSystemObject").FileExists(sOutputFilename) Then _
Kill sOutputFilename

wdExportFormatPDF = 17
wdExportOptimizeForPrint = 0
wdExportAllDocument = 0
wdExportDocumentContent = 0
wdExportCreateNoBookmarks = 0

wdDoc.ExportAsFixedFormat _
OutputFileName:=sOutputFilename, 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
wdDoc.Close False

errorExit:
On Error Resume Next
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Sub

errorHandler:
MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
Resume errorExit
End Sub

lapot
11-06-2014, 08:30 AM
The MakeWordPDFFile() routine has some unneeded variables. I originally coded it using a late binding method where those Word constant values are needed. Since I later decided to use an early binding method and added the Word object, those were already defined. It doesn't hurt anything to leave them as is.





Be sure to add the reference to the MSWord object as commented. In a module:

Function GetBaseName(Filespec As String) Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
GetBaseName = FSO.GetBaseName(Filespec)
End Function


Function TempPDF(aDrivePathFilenameExtension As String) As String
TempPDF = Environ("temp") & "\" & GetBaseName(aDrivePathFilenameExtension) & ".pdf"
End Function


'Requires Tools > References > Microsoft Word 14.0 Object Library
Sub MakeWordPDFFile(sMSWordFilename As String, sOutputFilename As String)
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim wdExportFormatPDF As Integer, wdExportOptimizeForPrint As Integer
Dim wdExportAllDocument As Integer, wdExportDocumentContent As Integer
Dim wdExportCreateNoBookmarks As Integer

If Not CreateObject("Scripting.FileSystemObject").FileExists(sMSWordFilename) Then _
Exit Sub

On Error GoTo errorHandler
Set wdApp = New Word.Application
With wdApp
Set wdDoc = .Documents.Open(sMSWordFilename)
.Visible = False
End With

If CreateObject("Scripting.FileSystemObject").FileExists(sOutputFilename) Then _
Kill sOutputFilename

wdExportFormatPDF = 17
wdExportOptimizeForPrint = 0
wdExportAllDocument = 0
wdExportDocumentContent = 0
wdExportCreateNoBookmarks = 0

wdDoc.ExportAsFixedFormat _
OutputFileName:=sOutputFilename, 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
wdDoc.Close False

errorExit:
On Error Resume Next
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Sub

errorHandler:
MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
Resume errorExit
End Sub




thank you for these codes , I have added MSWord object but where do I put the second code?

kind regards

Kenneth Hobs
11-06-2014, 11:15 AM
If you mean the block that you quoted, you quoted the answer:

In a module:

lapot
11-06-2014, 02:26 PM
If you mean the block that you quoted, you quoted the answer:


Thank you very much, it worked perfectly. You are a star. I cant find a wod to describe my feelings. I have been trying to sort this out weeks and you are the only one could solve it. I appricate so much.

do you think the PDF could be attached to an email by macro?

Kenneth Hobs
11-06-2014, 03:29 PM
Sure, one just needs to know the e-mail program, Outlook, Outlook Express, Thunderbird, Lotus Notes, etc. The first is the easiest since it is part of the MSOffice Suite. Feel free to start a new thread and reference this one if needed. There are several example out there about doing that already.

lapot
11-06-2014, 03:57 PM
Sure, one just needs to know the e-mail program, Outlook, Outlook Express, Thunderbird, Lotus Notes, etc. The first is the easiest since it is part of the MSOffice Suite. Feel free to start a new thread and reference this one if needed. There are several example out there about doing that already.


Ok , thank you very much again. You are a legend.
Best wishes