显示列表checkbox和多打印工作表中的所有工作表

我有一个excel电子表格与多个工作表,并希望能够点击“打印”button,这反过来打开一个对话框,我可以检查标记多个工作表,并单击“确定”,这将打印选定的工作表。 我一直在寻找通过网站,发现类似的情况下,但没有什么完全像这个问题。 目前我的代码只会打印一个空白页面:

Option Explicit Sub SelectSheets() Dim i As Integer Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim cb As CheckBox Application.ScreenUpdating = False ' Check for protected workbook If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If ' Add a temporary dialog sheet Set CurrentSheet = ActiveSheet Set PrintDlg = ActiveWorkbook.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(i) ' Skip empty sheets and hidden sheets If Application.CountA(CurrentSheet.Cells) <> 0 And _ CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = _ CurrentSheet.Name TopPos = TopPos + 13 End If Next i ' Move the OK and Cancel buttons PrintDlg.Buttons.Left = 240 ' Set dialog height, width, and caption With PrintDlg.DialogFrame .Height = Application.Max _ (68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 230 .Caption = "Select sheets to print" End With ' Change tab order of OK and Cancel buttons ' so the 1st option button will have the focus PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront ' Display the dialog box CurrentSheet.Activate Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show Then For Each cb In PrintDlg.CheckBoxes If cb.Value = xlOn Then Worksheets(cb.Caption).Select Replace:=False End If Next cb ActiveWindow.SelectedSheets.PrintOut copies:=1 ActiveSheet.Select End If Else MsgBox "All worksheets are empty." End If ' Delete temporary dialog sheet (without a warning) Application.DisplayAlerts = False PrintDlg.Delete ' Reactivate original sheet CurrentSheet.Activate End Sub 

我认为你对SelectedSheets的解释是造成这个问题的原因。 通过遍历工作表并select指定的工作表不会将这些工作表添加到SelectedSheets集合。 最简单的方法是在循环的每次迭代中逐页打印。

所以你的代码的这部分将会变成:

  For Each cb In PrintDlg.CheckBoxes If cb.Value = xlOn Then Worksheets(cb.Caption).PrintOut copies:=1 End If Next cb