Is this even possible?!?!?

[christianbiker]

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

 

[christianbiker]

Just reposting to see if someone has any suggestions...

 

[Domski]

Hi,

I've set up a spreadsheet that has various charts that change based on variables entered in a couple of cells.

The VBA routine runs through a predifined job list exporting the pdf files one by one to individual files.

Alas it uses Adobe Acrobat 6.0 Professional but if you like I can post the code for you to have a look at it.

Dom

 

[christianbiker]

Hi Dom,

I was originally trying to do this using Adobe Standard (6.0) but was unable to find any code or assistance which is why I went this route.

If you wouldn't mind posting it that would be greatly appreciated. It might help!!!

Thanks.

 

[Domski]

Hi,

Here you go:

Sub Create_PDF()

'Created by Dom Hill

Dim varDepartment As String
Dim varPageRef As String
Dim varSheets As String

Dim varEndDataFlag As Boolean

Dim tempPDFFileName As String
Dim tempPSFileName As String
Dim tempPDFRawFileName As String
Dim tempLogFileName As String
Dim tempFilePath As String

var_Response = MsgBox(Title:="Warning", Prompt:="You are about to produce PDF files for each of the departments in the Production List." _
& Chr(13) & Chr(13) & "Ensure that the correct period and file location have been specified." _
& Chr(13) & Chr(13) & "Are you sure you wish to proceed?", Buttons:=vbYesNo + vbExclamation)
If var_Response = vbNo Then Exit Sub

Application.ScreenUpdating = False

Sheets("Control").Activate

'Clear traffic lights

ActiveSheet.Unprotect

Columns("G:G").Interior.ColorIndex = xlNone

'Select first department

Range("Dept_Crit_Head").Offset(1, 0).Select

'Reset end data flag

varEndDataFlag = False

'Begin output process

Do While varEndDataFlag = False

    varDepartment = ActiveCell.Value
    varPageRef = ActiveCell.Offset(0, 1).Value
    varSheets = ActiveCell.Offset(0, 2).Value

'Update charts with required department for print

    Range("Department") = varDepartment

'Set file path and name

    tempFilePath = Range("FilePath").Value
    tempPDFRawFileName = tempFilePath & "\" & varPageRef & " " & varDepartment & " " & varSheets

'Define the postscript and .pdf file names.

Application.StatusBar = "Please wait, printing " & varDepartment

    tempPSFileName = tempPDFRawFileName & ".ps"
    tempPDFFileName = tempPDFRawFileName & ".pdf"
    tempLogFileName = tempPDFRawFileName & ".log"

' Print the Excel range to the postscript file

Sheets("Staffing Charts").PrintOut Copies:=1, preview:=False, ActivePrinter:="Adobe PDF", printtofile:=True, Collate:=True, prtofilename:=tempPSFileName

'Create PDF File

    Dim myPDFDist As New PdfDistiller
    myPDFDist.FileToPDF tempPSFileName, tempPDFFileName, tempShowWindow

'Delete PS File

    Kill tempPSFileName
    Kill tempLogFileName

    Sheets("Control").Activate
    
    Application.ScreenUpdating = True
    
'Update traffic light
  
    With ActiveCell.Offset(0, 3)
        .Interior.ColorIndex = 4
        .Interior.Pattern = xlSolid
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders.ColorIndex = xlAutomatic
    End With


'Cosmetic only - Scroll list down a row if row being processed it greater than row 30

    If ActiveCell.Row > 30 Then
    
        ActiveWindow.SmallScroll Down:=1

    End If
    
    Application.ScreenUpdating = False
    
    ActiveCell.Offset(1, 0).Select

'Check for blank department and update end procedure flag if so.

    If ActiveCell.Value = "" Then
    
        varEndDataFlag = True

    End If

Loop

Application.StatusBar = False
Application.ScreenUpdating = True

MsgBox ("Print job completed.")

Columns("G:G").Interior.ColorIndex = xlNone

Range("Department").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

A couple of things to note are I think you'll need to activate the Acrobat Distiller library in the VBA Editor under Tools...References

The print jobs are controlled by 3 variables extracted from a list on the Control worksheet:

- varDepartment holds the variable that controls the charts and part of the file name
- varPageRef and varSheets only hold information for the file name

It was mostly put together through trial and error but works a treat for me.

Hope it helps,

Dom

 

[christianbiker]

Hi Dom,

Thanks for the code...

I will see if I can get it to work however there is much I still don't understand with vba. If possbile could you give me some direction with the questions below Most of them revolve around the selecting ranges:

What range is this code specifically looking for:
Range("Dept_Crit_Head").Offset(1, 0).Select

Same Question:
Range("Department") = varDepartment

Same question:
tempFilePath = Range("FilePath").Value

When I change this to a test sheet (i.e. Sheet2) it looks like it is getting somewhere, but then it tells me I have a run time error 53 and that the file is not found. It the highlights Kill tempPSFileName as a debugging problem.

Sheets("Staffing Charts").PrintOut Copies:=1, preview:=False, ActivePrinter:="Adobe PDF", printtofile:=True, Collate:=True, prtofilename:=tempPSFileName

 

[Domski]

Hi,

Can understand it might be confusing as I'm no coder.

In answer to your questions:

Range("Dept_Crit_Head").Offset(1, 0).Select

I have a list that is interchangeable depending on what selection I make from a drop down selection depending on the report I'm making.

Basically Dept_Crit_Head is a cell that's named as the top left title for that list. Offset lets you choose a cell 'offsetted' by a specific number of rows and columns, hence the above selects the cell one cell down and zero cells to the right of that, i.e. the first deprtment that I want to process.

Range("Department") = varDepartment

I have another cell named as Department on the Control sheet which is the one that controls the data displayed in the charts. This takes the value taken from varDepartment set just above in the code and sets the cell to that value.

tempFilePath = Range("FilePath").Value

Again another cell on the Control sheet holds the path that the file should be written to, i.e. C:\Documents and Settings\Dom\My Documents. This sets the VBA variable to this so as it knows where to write the files to.

Hope some of this makes sense.

Laters,

Dom

 

[christianbiker]

well, i am not sure if this works because i am still getting a distiller error. i have looked in the reference library and cannot find distiller anywhere. i am receiving a compile error for this code:

myPDFDist As New PdfDistiller

 

[Domski]

I have a separate program from Adobe Acrobat 6.0 Prof that's called Acrobat 6.0 Distiller. It's a work application so didn't install it myself.

Might be worth seeeing if when you install Acrobat there's an option to install Distiller or checking out on the Adobe website whether it's something that only comes with Professional.

Sorry can't be more help, bit busy.