Question

我有一张包含多张纸的Excel电子表格，希望能够点击＆＃34; print＆＃34;按钮，然后打开一个对话框，我可以在其中选中标记多个工作表并单击＆＃34;确定＆＃34;这将打印选定的工作表。我一直在寻找通过网站，发现类似的情况，但没有完全像这个问题。目前我的代码只会打印一个空白页：

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

显示列表复选框和多打印工作表中的所有工作表

1 个答案: