Сохранить пользователя из списка в виде файла PDF

Question

Ниже приведен макрос, назначенный моей CommandButton «Создать отчет» для сохранения активной рабочей таблицы в виде файла 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

Ниже показано, как заполнить список 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) ) та же самая информация вставляется на вспомогательный лист, чтобы поддерживать список, позволяющий отправить этот лист в PDF.

Что-то подобное должно привести вас туда, внутри вашего Для цикла 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

---

Edit1:

Надеюсь, немного яснее (обратите внимание, что вам может понадобиться добавить лист в книгу, так как я произвольно использую 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