顯示列表中的所有工作表複選框和多個打印工作表

Question

我有一個excel電子表格與多個工作表，並希望能夠點擊「打印」按鈕，然後打開一個對話框，我可以檢查標記多個工作表，然後單擊「確定「，這將打印選定的工作表。我一直在尋找通過網站，發現類似的情況，但沒有什麼完全像這個問題。目前，我的代碼將只打印一頁空白頁：

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 

Answer 1

我覺得你的SelectedSheets解釋是造成問題的原因。通過遍歷工作表並選擇指定的工作表不會將這些工作表添加到SelectedSheets集合中。最簡單的方法是在循環的每次迭代中逐頁打印。

所以，你的這部分代碼將成爲：

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