+ Reply to Thread
Results 1 to 3 of 3

VBA Syntax for PDF

Hybrid View

  1. #1
    Registered User
    Join Date
    12-02-2007
    Posts
    5

    VBA Syntax for PDF

    Hi all.

    I have code that checks before a sheet is saved

    Workbook_BeforeSave
    What would I use if I wanted it check the same thing except it will be exporting to PDF and not saved.

    Thx.

  2. #2
    Forum Expert
    Join Date
    12-29-2004
    Location
    Michigan, USA
    MS-Off Ver
    2013
    Posts
    2,208
    Do you have a PDF converter installed on your PC? If not, that is your first step. I copied this from a thread I read a while back, so I cannot remember the exact source, but it should get you started:

    ---------------------------------------------------------

    I've searched the message board and found several questions, but not a good example of how to print automatically from Excel to a PDF file. After a couple of days of searching and tweaking, I've got what I think is a fairly good solution for automating your printing of worksheets to PDF files.

    This solution requires the use of PDF995. This is a free utility available at www.PDF995.com. This is a print driver that allows you to print to a PDF file. The file is compatible with Adobe and can be read with the Adobe reader like any other PDF. The free version does pop-up some advertising with each print, but the automation works with around the pop-ups. I believe the full license version is about $10 and doesn't produce the pop-ups.

    The challenge in automating a PDF process is that the PDF driver will prompt the user for a filename. This is ok if you are printing just one sheet, but if you need to automate the production of several PDFs, you need to be able to specify the name of the file in the code. The subroutine SheetToPDF presented below allows you to specify a single worksheet and the full filename for the PDF. I've included all the code and external declarations needed. The two subs at the bottom give examples of how to call SheetToPDF with the passed parameters.

    I hope you find this helpful.
    Regards,
    Steve

    'Needed to Read INI file settings 
    Declare Function GetPrivateProfileString Lib "kernel32" Alias _ 
    "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _ 
    ByVal lpKeyName As Any, ByVal lpDefault As String, _ 
    ByVal lpReturnedString As String, ByVal nSize As Long, _ 
    ByVal lpFileName As String) As Long 
    
    'Needed to Write INI file settings 
    Declare Function WritePrivateProfileString Lib "kernel32" Alias _ 
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _ 
    ByVal lpKeyName As Any, ByVal lpString As Any, _ 
    ByVal lpFileName As String) As Long 
    
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
    
    
    Sub SheetToPDF(WS As Worksheet, OutputFile As String) 
    
    ' This subroutine will print a worksheet to a PDF file using PDF995, a free utility 
    ' to generate PDF files. Download it at www.pdf995.com 
    
    ' Two arguments must be passed into this routine 
    ' 1. WS - A worksheet pointer 
    ' 2. OutputFile - The full path and name of the desired pdf file 
    
    ' Be sure to check that the "Generating PDF CS" setting in pdfsync.ini is set to 0 
    ' when pdf995 is idle. This codes uses that as a completion flag as it seems to be 
    ' the most reliable indication that PDF995 is done writing the pdf file. 
    
    Dim syncfile As String, maxwaittime As Long 
    Dim iniFileName As String 'tmpPrinter As Printer 
    Dim x As Long 
    Dim tmpoutputfile As String, tmpAutoLaunch As String 
    
    ' set the location of the PDF995.ini and the pdfsync files 
    iniFileName = "c:\pdf995\res\pdf995.ini" 
    syncfile = "c:\pdf995\res\pdfsync.ini" 
    
    ' save current settings from the PDF995.ini file 
    tmpoutputfile = ReadINIfile("PARAMETERS", "Output File", iniFileName) 
    tmpAutoLaunch = ReadINIfile("PARAMETERS", "Autolaunch", iniFileName) 
    
    ' remove previous pdf if it exists 
    On Error Resume Next 
    Kill OutputFile 
    On Error GoTo Cleanup 
    
    ' setup new values in PDF995.ini 
    x = WritePrivateProfileString("PARAMETERS", "Output File", OutputFile, iniFileName) 
    x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName) 
    
    'print the worksheet 
    WS.Select 
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDF995" 
    
    ' PDF995 operates asynchronously. We need to determine when it is done so we can 
    ' continue. This is done by checking the "Generating PDF CS" parameter in the pdfsync.ini 
    ' file. A loop with a 2 second delay is used to determine when it is finished. 
    
    Sleep (2000) ' pause 2 seconds (1000 = 1 sec) 
    maxwaittime = 60000 'If pdf995 isn't done in 60 seconds, quit anyway 
    Do While ReadINIfile("PARAMETERS", "Generating PDF CS", syncfile) = "1" And maxwaittime > 0 
    Sleep (2000) ' pause 2 seconds and re-check the status 
    maxwaittime = maxwaittime - 2000 
    Loop 
    
    ' restore the original default printer and the PDF995.ini settings 
    Cleanup: 
    x = WritePrivateProfileString("PARAMETERS", "Output File", tmpoutputfile, iniFileName) 
    x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", tmpAutoLaunch, iniFileName) 
    x = WritePrivateProfileString("PARAMETERS", "Launch", "", iniFileName) 
    On Error Resume Next 
    
    
    End Sub 
    
    Function ReadINIfile(sSection As String, sEntry As String, sFilename As String) As String 
    Dim x As Long 
    Dim sDefault As String 
    Dim sRetBuf As String, iLenBuf As Integer 
    Dim sValue As String 
    
    'Six arguments 
    'Explanation of arguments: 
    'sSection: ini file section (always between brackets) 
    'sEntry : word on left side of "=" sign 
    'sDefault$: value returned if function is unsuccessful 
    'sRetBuf$ : the value you're looking for will be copied to this buffer string 
    'iLenBuf% : Length in characters of the buffer string 
    'sFileName: Path to the ini file 
    
    sDefault$ = "" 
    sRetBuf$ = String$(256, 0) '256 null characters 
    iLenBuf% = Len(sRetBuf$) 
    x = GetPrivateProfileString(sSection, sEntry, _ 
    sDefault$, sRetBuf$, iLenBuf%, sFilename) 
    ReadINIfile = Left$(sRetBuf$, x) 
    
    End Function 
    
    
    Sub PrintToPDF() 
    ' This example prints the first sheet of the workbook. It calls the SheetToPDF subroutine, 
    ' passing it the worksheet pointer, and the PDFFileName (the worksheet name + .pdf) 
    
    Dim PDFFileName As String 
    PDFFileName = "c:\temp\" & Sheets(1).Name & ".pdf" 
    Call SheetToPDF(Sheets(1), PDFFileName) 
    End Sub 
    
    
    Sub PrintCPSheets() 
    ' This example prints specific named worksheets. It calls the SheetToPDF subroutine one 
    ' time for each sheet, passing it a worksheet pointer, and PDFFileName. 
    
    Dim CS As Worksheet 
    Dim PDFFileName As String 
    
    CurrentPath = "c:\temp\" 
    
    Set CS = Sheets("West") 
    PDFFileName = CurrentPath & CS.Name & ".pdf" 
    Call SheetToPDF(CS, PDFFileName) 
    
    Set CS = Sheets("Northeast") 
    PDFFileName = CurrentPath & CS.Name & ".pdf" 
    Call SheetToPDF(CS, PDFFileName) 
    
    Set CS = Sheets("Northeast") 
    PDFFileName = CurrentPath & CS.Name & ".pdf" 
    Call SheetToPDF(CS, PDFFileName) 
    
    Set CS = Sheets("Southeast") 
    PDFFileName = CurrentPath & CS.Name & ".pdf" 
    Call SheetToPDF(CS, PDFFileName) 
    
    Set CS = Sheets("Central") 
    PDFFileName = CurrentPath & CS.Name & ".pdf" 
    Call SheetToPDF(CS, PDFFileName) 
    
    End Sub

  3. #3
    Forum Contributor VBA Noob's Avatar
    Join Date
    04-25-2006
    Location
    London, England
    MS-Off Ver
    xl03 & xl 07(Jan 09)
    Posts
    11,988
    Steve,

    Code from this site

    http://www.excelguru.ca/node/21

    VBA Noob
    _________________________________________


    Credo Elvem ipsum etian vivere
    _________________________________________
    A message for cross posters

    Please remember to wrap code.

    Forum Rules

    Please add to your signature if you found this link helpful. Excel links !!!

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1