循环通过数据validation列表并执行打印macros

我有一个数据validation列表，其中包含每个月的员工名称，我手动通过每一个，并按下一个打印button，下面的macros。

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 

这将工作表打印到保存工作簿的path。

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

 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