EXCEL VBAで一括印刷プログラムシート「かんたん一括印刷クン」を作る（初心者向け）

Private Sub CommandButton1_Click()

  Dim buttom_cell As Long

  '■ポップアップ画面非表示・画面描写中止
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

  '■入力場所に空欄があった場合、それを破棄する
  Range("A:A").Select
  On Error Resume Next 'エラー回避
  Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp '空欄削除
  Range("A1").Select

  buttom_cell = Cells(Rows.Count, 1).End(xlUp).row 'A列の最も下のセルの行の場所を取得
  On Error GoTo error_nodata 'A列に何も入力されていなかった場合、myerrorへ

  '■ポップアップ画面非表示・画面描写中止
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

  ListBox1.List = Range(Cells(1, 1), Cells(buttom_cell, 1)).Value2
  MsgBox "登録件数は" & ListBox1.ListCount & "件です。" & vbCrLf & vbCrLf _
  & "印刷するシートの代入先のセルを選択し、" & vbCrLf & "「印刷スタート！」のボタンを押してください。"

  Exit Sub

error_nodata:  MsgBox "A列に何も記載がないか、1つのみとなっています。" & vbCrLf & vbCrLf & "A1セルから貼り付け/入力してください"

End Sub

Private Sub CommandButton2_Click()
  Dim msg0 As Integer
  Dim msg1 As Integer
  Dim i As Long
  Dim setting_printer As Boolean
  Dim S As String
  S = ActiveCell.Address

  If ListBox1.ListCount = 0 Then
    MsgBox "リストを読み込んでください。"
  Else
    msg0 = MsgBox("印刷するレポート（シート）は" & vbCrLf & "ファイル名：「" & ActiveWorkbook.Name & "」" _
    & vbCrLf & "シート名：「" & ActiveSheet.Name & "」、" & vbCrLf & "リストの代入先は「" & S & "」" & vbCrLf & "でよろしいですか？", vbYesNo + vbQuestion, "確認")
    If msg0 = vbYes Then
      setting_printer = Application.Dialogs(xlDialogPrinterSetup).Show    '印刷設定画面を開く
    '■印刷設定がキャンセルされた場合
      If setting_printer = False Then
        MsgBox "印刷がキャンセルされました"
        Exit Sub
      End If

      For i = 0 To 2
        ActiveCell.Value = ListBox1.List(i)
        Range(S) = Replace(Range(S), "", "") '数字が更新されない場合に対応。
        Range(S).Activate '指定のセルをアクティブにして、シートのイベントを発生させる。
        ActiveWindow.SelectedSheets.PrintOut 'シートを印刷(印刷ボタンを押す)
        On Error GoTo myerror1
      Next

myerror1:
      msg1 = MsgBox("正しく印刷されていますか？", vbYesNo + vbQuestion, "確認")
      If msg1 = vbYes Then
        For i = 3 To ListBox1.ListCount - 1
          ActiveCell.Value = ListBox1.List(i)
          Range(S) = Replace(Range(S), "", "")
          Range(S).Activate '指定のセルをアクティブにして、シートのイベントを発生させる。
          ActiveWindow.SelectedSheets.PrintOut 'シートを印刷(印刷ボタンを押す)
        Next
        MsgBox "印刷が完了しました！"
      Else
        MsgBox "もう一度設定しなおしてください。"
      End If
    Else
      MsgBox "もう一度セルを選択して下さい。"
    End If
  End If
Exit Sub

myerror2:
MsgBox "「印刷リスト」シートはこのファイルにありません。必要に応じて削除ください。"

End Sub

Sub 一括印刷クン起動()

 Dim ws As Worksheet, flag As Boolean
 一括印刷ユーザーフォーム.Show vbModeless

 For Each ws In Worksheets
  If ws.Name = "印刷リスト" Then flag = True
 Next ws

 If flag = True Then

  Sheets("印刷リスト").Visible = True
  Sheets("印刷リスト").Activate
  Columns("A:A").Select
  Range("A1").Select
  MsgBox "「印刷リスト」シートに" & vbCrLf & "必要なリストを貼り付けてください。"
  Exit Sub

 Else

 ActiveWorkbook.Sheets.Add
 On Error Resume Next
 ActiveSheet.Name = "印刷リスト"
 Columns("A:A").Select
 Range("A1").Interior.Color = 65535
 Range("B1") = "←ここから値で貼付け！"
 Range("A1").Select
 MsgBox "「印刷リスト」シートに" & vbCrLf & "必要なリストを貼り付けてください。"

 End If

End Sub