将用户表单列表框内容保存为 PDF 文件

Question

下面是分配给我的“生成报告”命令按钮的宏，用于将活动工作表保存为 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

下面是如何使用带有搜索按钮的 textboxsearch 填充 Userform 列表框。

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

Answer 1

您需要添加一个帮助表，以便在附加到列表框时 (Me.ListBox1.List(ListBox1.ListCount - 1, X - 1) = ws.Cells(i, X) em>) 将相同的信息粘贴到帮助表中，以维护允许您对该表进行 PDF 处理的列表。

这样的事情应该可以让你到达那里，在你的 For X 循环中：

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

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

您可以在您的 PDF 宏中添加一个循环来说明此其他工作表，例如：

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：

希望更清楚一点（注意你可能需要在工作簿中添加一张工作表，因为我随意使用 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