[XL]ユーザー定義ダイアログボックスのボタンがクリックされたら印刷を行う方法

詳細

ユーザー定義ダイアログ ボックス (以下 ダイアログ ボックス) に配置したボタンがクリックされたら印刷を行うようにするには、ボタンに登録するマクロの中で PrintOut メソッドを使用するのではなく、DialogSheet オブジェクトの Showメソッドを使用して、なおかつダイアログ ボックスを表示しているモジュール内をループ構造にします。
この方法はダイアログ ボックスを一旦クローズし、再度ダイアログ ボックスを表示するのでエラー メッセージ「スタック領域が不足しています。」が表示されるような状況に対して有効な方法です。
ダイアログ ボックスが表示されている最中は印刷や印刷プレビューを行うことはできないため、次の手順でダイアログ ボックスの表示と印刷 (印刷プレビュー)を行います。

サンプル

サンプル モジュールでは、次のような動作を行います。

1. ダイアログ ボックス "Dialog1" を表示します。
2. ダイアログ ボックス "Dialog1" の <印刷> ボタンがクリックされたらダイアログ ボックスを終了し、エディット ボックス "エディット 4" に入力されたセル参照を印刷範囲とし、WorkSheet オブジェクト の PrintOut メソッドを実行します。
3. 印刷が終了したら 1. に戻ります (<終了> ボタンがクリックされるまで続きます)。
   
   

モジュール

  Option Explicit
  Dim i As Integer
  Sub MyPrintDialog()
      Dim point As Variant
      Dim sheetname As String
      Dim refs As String
      Do
          i = 0
          DialogSheets("Dialog1").Show
          If i = 0 Then
              Exit Do
          End If
          point = Application.Search("!", DialogSheets("Dialog1") _
              .EditBoxes("エディット 4").Text)
          If IsError(point) Then
              sheetname = ActiveSheet.Name
              refs = DialogSheets("Dialog1") _
                   .EditBoxes("エディット 4").Text
          Else
              sheetname = Left(DialogSheets("Dialog1") _
                  .EditBoxes("エディット 4").Text, point - 1)
              refs = Mid(DialogSheets("Dialog1") _
                  .EditBoxes("エディット 4").Text, point + 1)
          End If
          Worksheets(sheetname).PageSetup.PrintArea = refs
          Worksheets(sheetname).PrintOut
      Loop While True
  End Sub
  Sub 印刷_Click()
      i = 1
  End Sub
  Sub フォーム 1_Show()
      DialogSheets("Dialog1").Buttons("印刷").DefaultButton = True
      DialogSheets("Dialog1").Buttons("印刷").DismissButton = True
      DialogSheets("Dialog1").Buttons("終了").CancelButton = True
      DialogSheets("Dialog1").EditBoxes("エディット 4").Text = ""
      DialogSheets("Dialog1").EditBoxes("エディット 4") _
          .InputType = xlReference
      DialogSheets("Dialog1").Focus = "エディット 4"
  End Sub