Question

我有一个数据验证列表，其中包含每个月的员工姓名，我手动浏览每个员工，然后按下带有以下宏的打印按钮。

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 = Cells.Range("B1") & " Period " & Cells.Range("J1")

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, _
    From:=1, _
    To:=2


End If

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

将此工作表打印到保存工作簿的路径。

我的数据验证列表在单元格'B1'中有没有办法可以使用VBA循环遍历列表并为我打印这些？我无法真正开始做草案，因为在vba中使用数据验证列表对我来说是全新的。

Sub Loop_Through_List()

Dim Name As Variant
'Dim List As ListBox?

For Each Name in List
  Call PDFActiveSheet
Next

Answer 1

您可以使用以下内容：

Sub Loop_Through_List()

    Dim cell                  As Excel.Range
    Dim rgDV                  As Excel.Range
    Dim DV_Cell               As Excel.Range

    Set DV_Cell = Range("B1")

    Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
    For Each cell In rgDV.Cells
        DV_Cell.Value = cell.Value
        Call PDFActiveSheet
    Next
End Sub

编辑：根据以下评论修改代码：

Sub Loop_Through_List()

    Dim cell                  As Excel.Range
    Dim rgDV                  As Excel.Range
    Dim DV_Cell               As Excel.Range

    Set DV_Cell = Range("B1")

    Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
    For Each cell In rgDV.Cells
        DV_Cell.Value = cell.Value
        Call PDFActiveSheet
    Next
End Sub
Sub PDFActiveSheet()
    Dim ws                    As Worksheet
    Dim myFile                As Variant
    Dim strFile               As String
    Dim sFolder               As String
    On Error GoTo errHandler

    Set ws = ActiveSheet

    'enter name and select folder for file
    ' start in current workbook folder
    strFile = ws.Range("B1").Value & " Period " & ws.Range("J1").Value

    sFolder = GetFolder()
    If sFolder = "" Then
        MsgBox "No folder selected. Code will terminate."
        Exit Sub
    End If
    myFile = sFolder & "\" & strFile

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

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

Function GetFolder() As String
    Dim dlg                   As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    dlg.InitialFileName = ThisWorkbook.Path & "\"
    dlg.Title = "Select folder to save PDFs"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

循环遍历数据验证列表并执行打印宏

1 个答案: