Hi,

   Can you send me your file? I can take a quick look if you want. Send it as a zip file to my e-mail at exp_[at]_exp-systems.com.

Michel

I still have trouble with this code in UserForm:

I get "Subscript out of range"
I highlighted in red where i didn't know what to introduce.

What i nedded was to print all sheets listed in ListBox2 in one PDF, and if it is possible to print selected sheets from all open workbooks in one PDF is very good.


'Example code showing how to create PDF files using PDF reDirect Pro Batch Printers

' API Declarations
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long



Private Sub UserForm_Initialize()
    Dim MyWorkbook As Workbook
    Dim MySheet As Worksheet
    For Each MyWorkbook In Application.Workbooks
        ' Make sure that this is not myself
        If MyWorkbook.name <> "GKVmenu v6.xla" Then
            ' Add this workbook to the list
            For Each MySheet In MyWorkbook.Sheets
               ListBox1.AddItem MyWorkbook.name & " >> " & MySheet.name
            Next MySheet
        End If
    Next MyWorkbook
End Sub


Private Sub remove_Click()

If ListBox2.ListIndex >= 0 Then
ListBox1.AddItem ListBox2.Text
ListBox2.RemoveItem ListBox2.ListIndex
End If

End Sub


Private Sub removeall_Click()

Do While ListBox2.ListCount > 0
ListBox1.AddItem ListBox2.List(0)
ListBox2.RemoveItem (0)
Loop

End Sub

Private Sub addall_Click()

Do While ListBox1.ListCount > 0
ListBox2.AddItem ListBox1.List(0)
ListBox1.RemoveItem (0)
Loop

End Sub

Private Sub add_Click()

If ListBox1.ListIndex >= 0 Then
ListBox2.AddItem ListBox1.Text
ListBox1.RemoveItem ListBox1.ListIndex
End If

End Sub


Private Sub printpdf_Click()

    Dim oPDF As New clsPrint_PDF_Pro
    Dim Result As Long
    Dim sPath As String
    Dim sFilename As String
    
    ' Recover Path & Filename from Sheet
    sPrinter = boxPrinter.Text
    sPath = boxPath.Text '.Range("D26").Formula
    sFilename = boxFilename.Text '.Range("D28").Formula
    
    ' Setup the PDF output path and filename
    Result = oPDF.SetOutput(sPrinter, sPath, sFilename)
    
    Dim arrayprint() As String
    Dim N As Integer
    N = 0
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            N = N + 1
            ReDim Preserve arrayprint(1 To N)
            arrayprint(N) = ListBox2.List(i)
        End If
    Next i
    If N = 0 Then
        MsgBox "You must select at least one Sheet"
        Exit Sub
    End If
       
   
    ' Check that there were no problems
    If Result = 1 Then
        ' No error occured: print to the Batch PDF Printer
       
        Application.Workbooks("test").Sheets(arrayprint).Printout1 , 1, 1, 0, sPrinter

       
        ' BONUS CODE THAT CHECKS FOR OUTPUT PDF
        '--------------------------------------
        ' Optional: this code is to wait until the file is created.
        '           Do this if you want to open the PDF in the PDF Reader.
        '           WARNING 1: the Excel Application will appear to "freeze"
        '           unless you add a progress bar of some kind (see the
        '           MS Word Example).
        '           WARNING 2: In the Batch Printer Preferences, make sure
        '           you do not select the option that will add a sequence
        '           number to the filename, otherwise, the target filename
        '           will never be found.
       
' Uncomment the next few lines to add optional code
'        ' Keep checking for the output file, up to 1 minute maximum
'        Dim MaxTime2Unlock As Single
'        MaxTime2Unlock = Timer() + 60
'
'        ' Start the loop
'        Do While MaxTime2Unlock >= Timer And Not CheckFileCreated(sPath & "\" & sFilename & ".pdf")
'            ' Share the CPU with other programs
'            Sleep (100)
'            DoEvents
'        Loop
'
'        ' Now, show the PDF in the PDF Reader
'        If CheckFileCreated(sPath & "\" & sFilename & ".pdf") Then
'            Call ShellExecute(0, "Open", sPath & "\" & sFilename & ".pdf", "", "", 3)
'        Else
'            ' Could not find the target PDF
'            MsgBox "ERROR: Output PDF not found."
'        End If

    Else
        ' An error occured, which can be as follows:
        ' 0 = UNKNOWN_ERROR
       
        ' PRINTER ERRORS
        ' 100 = PRINTER_NOT_FOUND
        ' 101 = COULD_NOT_ENUMERATE_PRINTERS
        ' 102 = COULD_NOT_OPEN_PRINTER
        ' 103 = COULD_NOT_SET_PRINTER_SETTINGS
        ' 104 = PRINTER_NOT_BATCH_PDF_PRINTER
       
        ' PATH ERRORS
        ' 105 = PATH_IS_NOT_VALID
        ' 106 = PATH_IS_EMPTY
        ' 107 = PATH_IS_GREATER_THAN_255_CHARACTERS
       
        ' FILENAME ERRORS
        ' 108 = FILENAME_IS_EMPTY
        ' 109 = FILENAME_IS_GREATER_THAN_200_CHARACTERS

        MsgBox "An Error occured while setting the Batch PDF." & vbCrLf & _
               "Error Number: " & Str(Result), _
               vbCritical, _
               "Critical Error"
    End If
    
    ' All done


End Sub


Private Function CheckFileCreated(FileName As String) As Boolean
    On Error GoTo ErrorHandler
    CheckFileCreated = False
    Name FileName As FileName
    CheckFileCreated = True
ErrorHandler:
End Function

"Test" is a acctually my file I'm working with.

Hi,

Sorry for delay, I was away for few days.

Still not working, any others ideas ?

Thanks!

Hi,

   Glad to hear that it is working better. Multiple PDF files will be created if the Sheets of the Excel File have different "Page Setup" settings. Although Microsoft does not call that a bug, they have posted a problem description and a fix on their web site.

   Anyway, you can find out all of the details on my forum [here].

   Cheers!

Michel

 

   Cool!