将用户窗体列表框内容另存为 PDF 文件

Save Userfrom Listbox Contents as PDF file

下面是分配给我的 "Generate Report" 命令按钮的宏,用于将活动工作表保存为 pdf 文件。我正在尝试使用此宏将我的用户表单列表框的内容另存为 PDF。这可以实现吗?

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

下面是如何使用带搜索按钮的文本框搜索填充用户表单列表框。

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

你需要添加一个助手 sheet 所以当你追加到列表框时 (Me.ListBox1.List(ListBox1.ListCount - 1, X - 1) = ws.Cells(i, X)) 将相同的信息粘贴到助手 sheet,以维护允许您将 sheet 设为 PDF 的列表。

像这样的东西应该会让你到达那里,在你的 For X 循环中:

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

请注意,在您的代码中,您正在合并一个更大的列表,因此仅收集该合并列表的有效方法是将其放在自己的位置以供以后使用。

您可以在 PDF 宏中添加一个循环来解决这个问题 sheet,例如:

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

编辑1:

希望更清楚一点(请注意,您可能需要在工作簿中添加 sheet,因为我随意使用 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