1 sml problem w/ saving to .pdf

Hlatigo

Well-known Member
Joined
Jun 3, 2002
Messages
677
I found this code from an early post. It prints to adobe perfectly and it saves to the path i have suggested. the only thing is...when it gets to this section of the code..it pops open a website. Does anyone have any thoughts to fix?

Code:
WS.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDF995"


the whole code and the original posting
http://www.mrexcel.com/forum/showthread.php?t=115191




Code:
'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 = "S:\USA-HOUSTON\CPDS\GT FAMM\IctsOnline\Global Trading\Risk Control\Updates for Internal Prices\U.S. Daily FPC\" & 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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,215,088
Messages
6,123,057
Members
449,091
Latest member
ikke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top