Excel/VBAマクロアシスタント

私はいくつかのコードに問題があり、誰かが助けてくれるかどうか疑問に思っていました。基本的に私は、私は（残念ながら、VBAとあまりにも経験の浅い）Excel/VBAマクロアシスタント

概要を簡単に説明し、自分自身をうまくできない2個のエラーを持っている：このマクロは、から選択したシートのコピーを新しいブックを生成するように設計されて

レポートバッチとしてクライアントに提示するための「ソース」ワークブック。本質的に - 私たちはマスターブック「A」を持っています。これには50タブ程度のものがあり、新しいブックに保存してクライアントに送るために2枚のシートをすばやく選択したいと考えています。コードは混乱のビットですが、私は/私が削除できるかなど

問題で何が起こっているのか本当にわからない：

Excelで添付コード/マクロを実行するとそれはやるべきことすべてを行いますが、マクロを実行するシートもコピーします。（つまり、ワークブックのシート1にある可能性があります。レポートを生成するためにマクロを実行し、チェックボックスメニューが表示され、シート2,5を選択します。& 9 - 新しいワークブックシート2,5 & 9とシート1にコピーします。しかし、チェックボックスメニューからシート1を選択したことはありません...）
このコードの実行が終了すると、Excelファイルを保存できません。それはちょうどクラッシュし、 "Microsoft Excelが動作を停止した"と、ファイルが死ぬと私はExcelを閉じて、等回復する必要がありますなど私はこの作業を取得するコードの2つの部分を結合し、私は、問題の原因となります。これと同様の方法でシートを印刷するためのコードがもう1つあります。これを実行すると、問題なく保存できます。

コード：私はすべての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

出典

2016-04-19 Dames

問題＃1は答えを参照してください。問題2についての情報を追加してください：あなたが投稿したコードは、互いに独立して動作する3つのサブシステムを持っているので、いくつかのボタン（UserFormまたはActiveXのいずれか）を使ってそれらを呼び出すとします。呼び出しの順序はクラッシュを生成しますか？ – user3598756

N°1

はブール変数

ブール
として暗い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

マクロ開始は、したがって、あなただけがPrintdlg選択したシートを経由してそれを追加し続けるWorksheets(CB.Caption).Select Replace:=Falseステートメントを使用する場合ときは、常にActiveWorksheetがありますので、。

出典

2016-04-19 10:10:04 user3598756

ありがとうございました！これはクラッシュする問題を解決しました。これ以上問題はありません。唯一の問題は、チェックボックスから複数のオプションを選択した場合、選択肢のすべてではなく、1枚のみをコピーすることです。 – Dames

ありがとうございました！これは実際にすべての私の問題を解決しました。ファイルはこのマクロを実行した後もクラッシュすることはなくなりました。余分なサブについては、実際には使用されないので無視することができます。私は上記のコードにそれを含めてはいけません。 – Dames

Excel/VBAマクロアシスタント

答えて

関連する問題