christianbiker
Active Member
- Joined
- Feb 3, 2006
- Messages
- 365
I found a large post regarding printing to PDF using pdf995 and I have got it working just fine (I have attached the code below). I do have a challenge on my hands though...
I would like to print a number of different files each with their own name & with their own information that is based on formulas and the changing of one cell in Excel. Below is the code that I am currently using to change each filename however I am not currently using it with the PDF function and have no idea how to integrate it into the code. If anyone has a suggestion that would be greatly appreciated.
Thanks.
Save Code:
Sheets("MONTHLY REPORT").Activate
Dim c As Range
Dim pword As String
pword = "nohs1"
ActiveSheet.unprotect pword
On Error Resume Next
Application.ScreenUpdating = False
' Where the list of branches is in Column O
For Each c In Range([R1], Cells(Rows.Count, "R").End(xlUp))
Range("O44") = c.Value
ActiveSheet.Copy
With ActiveWorkbook
.saveas Filename:="C:\Documents and Settings\cking\My Documents\WCB Reports\Monthly WCB Report - " & c.Value
.ChangeFileAccess xlReadOnly
Kill .FullNameprint
.Close False
End With
Next c
Application.ScreenUpdating = True
On Error GoTo 0
ActiveSheet.protect Password, True, True, True
Sheets("Generate & Email Monthly Report").Activate
PDF Print 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:\program files\pdf995\res\pdf995.ini"
syncfile = "c:\program files\pdf995\res\pdfsync.ini"
' save current settings from the PDF995.ini file
tmpoutputfile = ReadINIfile("PARAMETERS", "C:\Documents and Settings\Owner\My Documents\chad.pdf", 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", "C:\Documents and Settings\Owner\My Documents\chad.pdf", "C:\Documents and Settings\Owner\My Documents\chad.pdf", iniFileName)
x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName)
'print the worksheet
Sheet1.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", "C:\Documents and Settings\Owner\My Documents\chad.pdf", 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 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:\Documents and Settings\Owner\My Documents\"
Set CS = Sheets("Sheet1")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
End Sub
I would like to print a number of different files each with their own name & with their own information that is based on formulas and the changing of one cell in Excel. Below is the code that I am currently using to change each filename however I am not currently using it with the PDF function and have no idea how to integrate it into the code. If anyone has a suggestion that would be greatly appreciated.
Thanks.
Save Code:
Sheets("MONTHLY REPORT").Activate
Dim c As Range
Dim pword As String
pword = "nohs1"
ActiveSheet.unprotect pword
On Error Resume Next
Application.ScreenUpdating = False
' Where the list of branches is in Column O
For Each c In Range([R1], Cells(Rows.Count, "R").End(xlUp))
Range("O44") = c.Value
ActiveSheet.Copy
With ActiveWorkbook
.saveas Filename:="C:\Documents and Settings\cking\My Documents\WCB Reports\Monthly WCB Report - " & c.Value
.ChangeFileAccess xlReadOnly
Kill .FullNameprint
.Close False
End With
Next c
Application.ScreenUpdating = True
On Error GoTo 0
ActiveSheet.protect Password, True, True, True
Sheets("Generate & Email Monthly Report").Activate
PDF Print 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:\program files\pdf995\res\pdf995.ini"
syncfile = "c:\program files\pdf995\res\pdfsync.ini"
' save current settings from the PDF995.ini file
tmpoutputfile = ReadINIfile("PARAMETERS", "C:\Documents and Settings\Owner\My Documents\chad.pdf", 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", "C:\Documents and Settings\Owner\My Documents\chad.pdf", "C:\Documents and Settings\Owner\My Documents\chad.pdf", iniFileName)
x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName)
'print the worksheet
Sheet1.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", "C:\Documents and Settings\Owner\My Documents\chad.pdf", 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 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:\Documents and Settings\Owner\My Documents\"
Set CS = Sheets("Sheet1")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
End Sub