Помощь в макросах Excel/VBA

Question

У меня проблемы с некоторым кодом, и мне было интересно, может ли кто-то помочь. В принципе у меня есть 2 ошибки, которые я не могу работать сам (слишком неопытен с VBA, к сожалению)

Краткий обзор:

Этого макрос предназначен для создания новой книги с копиями отдельных листов из «исходной» рабочей книгой для представления клиентам в виде пакета отчетов. По существу - у нас есть мастер-книга «А», которая может иметь 50 вкладок или около того, и мы хотим быстро выбрать пару листов для «копирования» в новую книгу для сохранения и отправки клиенту. Код немного беспорядка, но я не совсем уверен, что происходит/то, что я могу удалить и т.д.

Проблемы:

1. При запуске прилагаемого кода/макроса в Excel , он делает все, что он должен делать, однако он также копирует лист, с которого вы запускаете макрос. (т. е. я могу быть на листе 1 в рабочей книге. Запустите макрос для создания отчетов, появится окно флажка, и я выбираю листы 2, 5 & 9 - он затем скопирует в новые листы книги 2, 5 & 9 И лист 1. Но я никогда не выбрал лист 1 из меню флажка ...)

2. Как только этот код закончил работать, я не могу сохранить файл Excel. Он просто падает и говорит: «Microsoft Excel перестала работать», а затем файл умирает, и мне нужно закрыть Excel, восстановить и т. Д. И т. Д. Я объединил 2 части кода, чтобы заставить это работать, и я думаю, что я могу упустить что-то важное, что вызывая проблему. У нас есть еще один фрагмент кода, чтобы распечатать листы аналогичным образом, и если я запустил это, я смог бы сэкономить без проблем.

Код:

Я включил все основные код Визуальная (т.е. для создания отчетов & печатных листов макросов).

У меня действительно нет опыта работы с 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

• добавить объявление о булевой переменной

  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 выбранных листов.