将列表框内容中的用户另存为PDF文件

时间:2018-12-26 08:45:07

标签: excel-vba pdf listbox 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

下面是通过使用带有搜索按钮的textboxsearch填充用户窗体列表框的方式。

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

1 个答案:

答案 0 :(得分:1)

您将要添加一个辅助表单,以便在添加到列表框时( Me.ListBox1.List(ListBox1.ListCount-1,X-1)= ws.Cells(i,X)),将相同的信息粘贴到帮助表中,以维护列表,使您可以对该表进行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