Search code examples
excelvbapdflistboxreport

Save Userfrom Listbox Contents as PDF file


Below is the macro assigned to my "Generate Report" CommandButton to save the active worksheet as a pdf file. I am trying to use this macro to save the contents of my userform listbox as a PDF instead. Is this achievable?

Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler

Set ws = ActiveSheet

'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(ws.Name, " ", ""), ".", "_") _
            & "_" _
            & Format(Now(), "yyyymmdd\_hhmm") _
            & ".pdf"
strFile = ThisWorkbook.Path & "\" & strFile

myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

If myFile <> "False" Then

    ws.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

     With ws.PageSetup
         .CenterHeader = "Asset List"
         .Orientation = xlPortrait
         .Zoom = True
         .FitToPagesTail = False
         .FitToPagesWide = 1
     End With

    MsgBox "PDF file has been created."
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Below is how the Userform listbox is populated by using the textboxsearch with search button.

Private Sub SearchButton_Click()

'ListBox1.Clear
ListBox1.RowSource = ""
ListBox1.ColumnHeads = False

'listbox column headers
 Me.ListBox1.AddItem
 For A = 1 To 8
     Me.ListBox1.List(0, A - 1) = Sheet2.Cells(1, A)
 Next A
 Me.ListBox1.Selected(0) = True


'Populating listbox1 from search
 Dim i As Long
 Dim ws As Worksheet

 Dim SheetList(0 To 1) As String
 Dim k As Integer

SheetList(0) = "Sheet1"
SheetList(1) = "Sheet2"

  For k = LBound(SheetList) To UBound(SheetList)
     Set ws = Sheets(SheetList(k))

     For i = 2 To ws.Range("A100000").End(xlUp).Offset(1, 0).Row
         For j = 1 To 8
             H = Application.WorksheetFunction.CountIf(ws.Range("A" & i, "H" & i), ws.Cells(i, j))
             If H = 1 And LCase(ws.Cells(i, j)) = LCase(Me.SearchTextBox) Or H = 1 And _
             ws.Cells(i, j) = Val(Me.SearchTextBox) Then
                 Me.ListBox1.AddItem
                 For X = 1 To 8
                     Me.ListBox1.List(ListBox1.ListCount - 1, X - 1) = ws.Cells(i, X)
                 Next X
             End If
         Next j
     Next i
 Next k

'Count the listbox rows when populated
 With Me.ListBox1
 For X = 0 To .ListCount - 1
     Total = X
 Next X
 End With

End Sub

Solution

  • You'll want to add a helper sheet so when you append to the listbox (Me.ListBox1.List(ListBox1.ListCount - 1, X - 1) = ws.Cells(i, X)) that same information is pasted to the helper sheet, to maintain the list allowing you to PDF that sheet.

    Something like this should get you to there, inside of your For X loop:

    With Sheets("Sheet3")
        .Cells(.Rows.Count,1).End(xlUp).Row,1).Value = ws.Cells(i, X)
    End With
    

    Note that in your code you are consolidating a much larger list, so an efficient way to only collect that consolidated list would be to put it in its own location to utilize later.

    You can add a loop to your PDF macro to account for this other sheet, such as:

    Dim i as long, arr as variant
    arr = array("Sheet1","Sheet3")
    For i = lbound(arr) to ubound(arr) 
        With Sheets(arr(i))
            'PDFing macro
        End with
    Next i
    

    Edit1:

    Hopefully a little more clear (note that you may need to add a sheet to the workbook, as i am arbitrarily using Sheet3):

    For X = 1 To 8
        Me.ListBox1.List(ListBox1.ListCount - 1, X - 1) = ws.Cells(i, X)
        With Sheets("Sheet3")
            .Cells(.Rows.Count,1).End(xlUp).Row,1).Value = ws.Cells(i, X)
        End With
    Next X