Ask VBA how to Print separate PDF

[ahdiethya]

Hi All,

I made a print worksheet design with checkboxes in vba excel, but I don't know how to print out a separate pdf.
maybe someone can help me.
Thank You

Option Explicit


Private Sub CheckBoxAll_Click()
        
    Dim formControl As MSForms.Control
    Dim cb As MSForms.CheckBox
        
    'Select or unselect all other CheckBox controls
    
    For Each formControl In Me.Controls
        Debug.Print formControl.Name, TypeName(formControl)
        If TypeName(formControl) = "CheckBox" Then
            If formControl.Name <> "CheckBoxAll" Then
                Set cb = formControl
                cb.Value = Me.Controls("CheckBoxAll").Value
            End If
        End If
    Next

End Sub


Private Sub CommandButton1_Click()

    Dim formControl As MSForms.Control
    Dim cb As MSForms.CheckBox
    Dim s As Integer, n As Integer
    Dim printSheets() As String
    Dim currentSheet As Worksheet
    Dim sheetNames As Variant
    
    Set currentSheet = ActiveSheet

    sheetNames = Array("Karimun Sejahtera", "Karimun Sejahtera Tg Batu", "Dana Central Mulia", "Dana Central Mulia Karimun", "Dana Bintan Sejahtera Pusat", "Dana Bintan Sejahtera Kijang", "Artha Margahayu")
    
    'Look at each CheckBox control -  print selected sheets
    
    n = 0
    s = 0
    For Each formControl In Me.Controls
        'Debug.Print formControl.Name, TypeName(formControl)
        If TypeName(formControl) = "CheckBox" Then
            If formControl.Name <> "CheckBoxAll" Then
                Set cb = formControl
                If cb.Value = True Then
                    ReDim Preserve printSheets(n)
                    printSheets(n) = sheetNames(s)
                    n = n + 1
                End If
                s = s + 1
            End If
        End If
    Next

    If n >= 1 Then
    
        'At least 1 sheet selected, so minimise userform and show print dialogue
        
        Show_Window Me.Caption, SW_SHOWMINIMIZED
        Worksheets(printSheets).Select
        Application.Dialogs(xlDialogPrint).Show
        
        'Restore userform
        
        Show_Window Me.Caption, SW_SHOWNORMAL
        currentSheet.Select
        
    End If
    
End Sub

[CODE=vba]
Option Explicit

Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
    
Private Const ConstWindowsClass As String = "ThunderDFrame"
   
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type

'Windows API calls to do all the dirty work!
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetSystemMenu Lib "USER32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare PtrSafe Function DeleteMenu Lib "USER32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "USER32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function EnableWindow Lib "USER32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SetFocus Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare PtrSafe Function LockWindowUpdate Lib "USER32" (ByVal hWndLock As Long) As Long
Private Declare PtrSafe Function GetWindowPlacement Lib "USER32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare PtrSafe Function SetWindowPlacement Lib "USER32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long

#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetWindowPlacement Lib "USER32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long
#End If

'Private Declare Function GetWindowPlacement Lib "USER32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long
'Private Declare Function SetWindowPlacement Lib "USER32" (ByVal hwnd As Long, ByRef lpwndpl As WINDOWPLACEMENT) As Long


Public Sub Show_Window(windowCaption As String, showState As Long)

    Dim hwnd As Long
    Dim wp As WINDOWPLACEMENT
    
    'Get the window handle of the UserForm
    
    hwnd = FindWindow(ConstWindowsClass, windowCaption)
    If hwnd > 0 Then
        wp.Length = Len(wp)
        GetWindowPlacement hwnd, wp
        wp.showCmd = showState
        SetWindowPlacement hwnd, wp
    End If
    
End Sub

 

[ceranes]

So if I understand you correctly, you can print to a printer, but you want the VBA to print directly to PDF instead?

 

[ceranes]

If that's the case, you can modify the CommandButton1_Click() subroutine to print the selected worksheets to a PDF instead of displaying the print dialog. You would use the ExportAsFixedFormat method.
Replace 'YourUsername' with your actual username in the pdfPath variable, and make sure the specified folder exists.

This modified subroutine will save the selected worksheets as a single PDF file named 'SelectedSheets.pdf' on your desktop. You can change the pdfPath variable to your desired file path. Note that this code will overwrite the existing PDF file with the same name without any warning. If you want to prevent overwriting, you can add code to check for an existing file and prompt the user for a new name or confirm the overwriting.

Please reply with any problems and I'll try and help.

Private Sub CommandButton1_Click()

    Dim formControl As MSForms.Control
    Dim cb As MSForms.CheckBox
    Dim s As Integer, n As Integer
    Dim printSheets() As String
    Dim currentSheet As Worksheet
    Dim sheetNames As Variant
    Dim pdfPath As String

    Set currentSheet = ActiveSheet

    sheetNames = Array("Karimun Sejahtera", "Karimun Sejahtera Tg Batu", "Dana Central Mulia", "Dana Central Mulia Karimun", "Dana Bintan Sejahtera Pusat", "Dana Bintan Sejahtera Kijang", "Artha Margahayu")

    'Look at each CheckBox control - print selected sheets

    n = 0
    s = 0
    For Each formControl In Me.Controls
        'Debug.Print formControl.Name, TypeName(formControl)
        If TypeName(formControl) = "CheckBox" Then
            If formControl.Name <> "CheckBoxAll" Then
                Set cb = formControl
                If cb.Value = True Then
                    ReDim Preserve printSheets(n)
                    printSheets(n) = sheetNames(s)
                    n = n + 1
                End If
                s = s + 1
            End If
        End If
    Next

    If n >= 1 Then
        'At least 1 sheet selected, so minimise userform and print to PDF

        ' Set the PDF path to save the file
        pdfPath = "C:\Users\YourUsername\Desktop\SelectedSheets.pdf"
        
        Show_Window Me.Caption, SW_SHOWMINIMIZED
        Worksheets(printSheets).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        
        'Restore userform
        Show_Window Me.Caption, SW_SHOWNORMAL
        currentSheet.Select
    End If

End Sub

 

[ahdiethya]

So if I understand you correctly, you can print to a printer, but you want the VBA to print directly to PDF instead?

It's true, i wanto to print directly to PDF, but how to make it as separate pdf?
i mean each worksheet will be a different pdf file.
I tried your code, it works, but the pdf results are combined.

 

[ceranes]

Ok, give this a try. It will loop through the sheets until all of them are saved as individual PDF files. Make sure to replace "YourUsername" with your actual username in the pdfPath variable, and make sure the specified folder exists.

Private Sub CommandButton1_Click()

    Dim formControl As MSForms.Control
    Dim cb As MSForms.CheckBox
    Dim s As Integer, n As Integer
    Dim printSheets() As String
    Dim currentSheet As Worksheet
    Dim sheetNames As Variant
    Dim pdfPath As String
    Dim ws As Worksheet

    Set currentSheet = ActiveSheet

    sheetNames = Array("Karimun Sejahtera", "Karimun Sejahtera Tg Batu", "Dana Central Mulia", "Dana Central Mulia Karimun", "Dana Bintan Sejahtera Pusat", "Dana Bintan Sejahtera Kijang", "Artha Margahayu")

    'Look at each CheckBox control - print selected sheets

    n = 0
    s = 0
    For Each formControl In Me.Controls
        If TypeName(formControl) = "CheckBox" Then
            If formControl.Name <> "CheckBoxAll" Then
                Set cb = formControl
                If cb.Value = True Then
                    ReDim Preserve printSheets(n)
                    printSheets(n) = sheetNames(s)
                    n = n + 1
                End If
                s = s + 1
            End If
        End If
    Next

    If n >= 1 Then
        'At least 1 sheet selected, so minimise userform and print to separate PDFs

        Show_Window Me.Caption, SW_SHOWMINIMIZED

        For Each wsName In printSheets
            Set ws = Worksheets(wsName)
            
            ' Set the PDF path to save the file
            pdfPath = "C:\Users\YourUsername\Desktop\" & wsName & ".pdf"

            ' Save the worksheet as a separate PDF
            ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Next wsName
        
        'Restore userform
        Show_Window Me.Caption, SW_SHOWNORMAL
        currentSheet.Select
    End If

End Sub

 

[ahdiethya]

O, Alhamdulillah. That's works!
Thankyou

 

[ceranes]

You're welcome!!