Question

我在使用某些代码时遇到了一些麻烦，并且想知道是否有人可以提供帮助。基本上我有2个错误，我自己可以解决（不幸的是，对VBA太缺乏经验）

简要概述：

此宏旨在生成一个新工作簿，其中包含来自＆＃34;来源＆＃34;工作簿，以作为报告批次呈现给客户。基本上 - 我们有硕士工作手册＆＃34; A＆＃34;它可能有50个左右的标签，我们想快速选择几张纸来复制＆＃34;进入一个新的工作簿保存并发送给客户端。代码有点乱，但我不确定发生了什么/我可以删除等等。

问题：

当您在Excel中运行附加的代码/宏时，它会执行它应该执行的所有操作，但是，它也会复制运行宏的工作表。（即我可能在工作簿的第1页上。运行宏来生成报告，出现复选框菜单，然后我选择工作表2,5和9 - 然后它将复制到新的工作簿工作表2,5和9和工作表中1.但我从未从复选框菜单中选择第1张......）
此代码运行完毕后，我无法保存Excel文件。它只是崩溃并说'＃Excel; Microsoft Excel已停止工作＆＃34;然后文件死了，我必须关闭Excel并恢复等等。我结合了两段代码来实现这一点，我想我可能会遗漏一些导致问题的关键因素。我们还有另一段代码以与此类似的方式打印表格，如果我运行此代码，我可以毫无问题地保存。

代码：

我已经包含了所有Visual Basic代码（即用于生成报告和打印工作表宏）。

我真的没有任何VBA经验，所以我希望有人能够提供帮助！在此先感谢：）

Sub PrintSelectedSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim Printdlg As DialogSheet
Dim CurrentSheet As Worksheet, wsStartSheet 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 wsStartSheet = 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
wsStartSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then

'the following code will print the selected sheets as multiple print jobs.
'continuous page numbers will therefore not be printed

    If Printdlg.Show Then

        For Each CB In Printdlg.CheckBoxes
            If CB.Value = xlOn Then
                Worksheets(CB.Caption).Activate
                ActiveSheet.PrintOut
                'ActiveSheet.PrintPreview 'for debugging
                End If
                Next CB

 'the following code will print the selected sheets as a single print job.
 'This will allow the sheets to be printed with continuous page numbers.

        '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
        Else
            MsgBox "No worksheets selected"
        End If
    'End If

End If

'Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
Printdlg.Delete

'Reactivate original sheet
CurrentSheet.Activate
wsStartSheet.Activate

End Sub

Sub GenerateClientExcelReports()

'1. Declare variables

Dim i As Integer
Dim SheetCount As Integer
Dim TopPos As Integer
Dim lngCheckBoxes As Long, y As Long
Dim intTopPos As Integer, intSheetCount As Integer
Dim intHor As Integer       'this will be for the horizontal position of the items
Dim intWidth As Integer     'this will be for the overall width of the dialog box
Dim intLBLeft As Integer, intLBTop As Integer, intLBHeight As Integer
Dim Printdlg As DialogSheet
Dim CurrentSheet As Worksheet, wsStartSheet As Worksheet
Dim CB As CheckBox

 'Dim wb As Workbook
 'Dim wbNew As Workbook
 'Set wb = ThisWorkbook
 'Workbooks.Add ' Open a new workbook
 'Set wbNew = ActiveWorkbook

On Error Resume Next
Application.ScreenUpdating = False

'2.   Check for protected workbook

If ActiveWorkbook.ProtectStructure Then
    MsgBox "Workbook is protected.", vbCritical
    Exit Sub
End If

'3.   Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set wsStartSheet = ActiveSheet
Set Printdlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

'4.   Add the checkboxes

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
    Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'5.       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

'6.   Move the OK and Cancel buttons
Printdlg.Buttons.Left = 240

'7.   Set dialog height, width, and caption
With Printdlg.DialogFrame
    .Height = Application.Max _
        (68, Printdlg.DialogFrame.Top + TopPos - 34)
    .Width = 230
    .Caption = "Select sheets to generate"

End With

'8.   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

'9.   Display the dialog box
CurrentSheet.Activate
wsStartSheet.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

                       'For y = 1 To ActiveWorkbook.Worksheets.Count
                            'If WorksheetFunction.IsNumber _
                            '(InStr(1, "ActiveWorkbook.Sheets(y)", "Contents")) = True Then
                                'CB.y = xlOn
                            'End If

                    End If

                Next


                ActiveWindow.SelectedSheets.Copy

        Else
            MsgBox "No worksheets selected"


        End If

End If

'Delete temporary dialog sheet (without a warning)
'Application.DisplayAlerts = False
'Printdlg.Delete

'Reactivate original sheet
'CurrentSheet.Activate
'wsStartSheet.Activate

'10.   Delete temporary dialog sheet (without a warning)

Application.DisplayAlerts = False
Printdlg.Delete

'11.   Reactivate original sheet

CurrentSheet.Activate
wsStartSheet.Activate
Application.DisplayAlerts = True

End Sub

Sub SelectAllCheckBox()
Dim CB As CheckBox

For Each CB In ActiveSheet.CheckBoxes
    If CB.Name <> ActiveSheet.CheckBoxes(1).Text Then
        CB.Value = ActiveSheet.CheckBoxes(1).Value
    End If
Next CB

'ActiveSheet.CheckBoxes("Check Box 1").Value
End Sub

Answer 1

问题n°1

添加布尔变量的声明

Dim firstSelected As Boolean

然后修改For Each CB In Printdlg.CheckBoxes循环块代码，如下所示

        If CB.Value = xlOn Then
            If firstSelected Then
                Worksheets(CB.Caption).Select Replace:=False
            Else
                Worksheets(CB.Caption).Select
                firstSelected = True
            End If

           'For y = 1 To ActiveWorkbook.Worksheets.Count
                'If WorksheetFunction.IsNumber _
                '(InStr(1, "ActiveWorkbook.Sheets(y)", "Contents")) = True Then
                    'CB.y = xlOn
                'End If
        End If

因为宏启动时始终存在ActiveWorksheet，因此如果您只使用Worksheets(CB.Caption).Select Replace:=False语句，则会将其添加到所选的Printdlg张选项中。

Excel / VBA宏辅助

1 个答案: