Excel / VBAmacros援助

我有一些代码有点麻烦，并想知道如果有人可以提供帮助。 基本上我有两个错误，我不能自己工作（不幸的是，与VBA不熟悉）

简要概述：

此macros用于生成新工作簿，其中包含“源”工作簿中所选工作表的副本，以便作为报表批处理呈现给客户。 从本质上讲，我们有主工作簿“A”，可能有50个标签左右，我们希望快速select几张表格“复制”到一个新的工作簿保存并发送到客户端。 代码有点乱，但我不确定发生了什么/我可以删除什么。

问题：

1. 当你在Excel中运行附加的代码/macros时，它会完成它应该做的所有事情，但是，它也会复制你运行macros的工作表。 （即我可能在工作簿中的工作表1上运行macros来生成报告，checkbox菜单出现，我select工作表2，5和9 – 它将复制到一个新的工作簿表2，5和9和表1。但是我从来没有从checkbox菜单中select表单1）

2. 一旦这段代码完成运行，我无法保存Excel文件。 它只是崩溃，并说“Microsoft Excel已停止工作”，然后文件死亡，我必须closuresExcel和恢复等。等我结合了2个代码来得到这个工作，我想我可能会失去一些至关重要的是造成这个问题。 我们有另外一个代码来以类似的方式打印出来，如果我运行这个，我可以保存没有问题。

码：

我已经包含了所有的Visual Basic代码（即生成报告和打印表单macros）。

我真的没有任何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

至于问题1

• 添加一个布尔variables的声明

  昏暗firstSelected为布尔值

• 然后修改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 

因为macros开始时总是有一个ActiveWorksheet ，所以如果你只使用Worksheets(CB.Caption).Select Replace:=False语句，你不断的把它添加到通过Printdlg选中的表单上。