進行状況を表示する

  1. Home
  2. Excel
  3. VBA
  4. Excel VBA Tips

1つ上のコンテンツで、時間のかかるマクロを実行中に「お待ちください」メッセージを出す方法を解説しました。ポイントは、時間のかかるマクロをUserFormのActivateイベントで実行するという考え方です。詳しくは「「お待ちください」メッセージの表示」をご覧ください。

その「お待ちください」メッセージには、できれば「現在の進行状況」を示したいところです。今回は、そのための考え方です。なお、Excel 2000以降ではUserFormをモードレスで表示する方法もありますが、本稿ではExcel 97までを対象にした基本的な考え方を解説します。何はともあれ、次のようなUserFormを準備してください。

標準モジュールのSub Sample1から、このUserForm1を呼び出します。

Sub Sample1()
    UserForm1.Show
End Sub

UserForm1のActivateイベントに次のコードを記述します。途中で処理を停止できるようにするため、広域変数flagも宣言します。このへんの仕組みがわからない方は、「「お待ちください」メッセージの表示」で解説していますのでご覧ください。

現在の処理回数を表示する

「現在の進行状況」にはいくつかの種類があります。最初は「現在の何番目の処理をしているか」を表示してみましょう。ここでは、セル範囲A1:A1000に数値を入力する処理を例にします。

Dim flag As Boolean
Private Sub CommandButton1_Click()
    If MsgBox("終了しますか？", 292) = vbYes Then flag = True
End Sub
Private Sub UserForm_Activate()
    Dim i As Long
    Me.Repaint
    For i = 1 To 1000
        Cells(i, 1) = i
        Label2 = i & "回目を処理中..."
        DoEvents
        If flag = True Then Exit For
    Next i
    Unload Me
End Sub

ポイントはDoEvents関数です。Label2に「○回目を処理中」と表示する命令は「Label2 = i & "回目を処理中..."」で正しいのですが、これだけでは望む結果は得られません。UserFormが画面に表示され、その後For Nextステートメントで繰り返し処理を行っている間は、最初に表示されたUserFormに対する変更が反映されないからです。

DoEvents関数はCPUの制御を解放する働きがあります。時間のかかるFor Nextステートメントは、完了するまでCPUを独り占めしてしまいますので、その間に実行したLabel2への書き換えリクエストは反映されず、For Nextステートメントが完了してから書き換えが行われることになります。それでは意味がありませんので、DoEvents関数を実行してCPUの"独り占め"を解放してやらなければならないんです。

さて、上のサンプルでは「○回目を処理中」とだけ表示しましたが、それが処理全体で見てどれくらいなのかを表示してあげた方が親切でしょうね。

Private Sub UserForm_Activate()
    Dim i As Long, MaxCount As Long
    Me.Repaint
    MaxCount = 1000
    For i = 1 To MaxCount
        Cells(i, 1) = i
        Label2 = i & "を処理中...(" & i & " / " & MaxCount & ")"
        DoEvents
        If flag = True Then Exit For
    Next i
    Unload Me
End Sub

処理回数を変数に入れてみました。これなら「MaxCount = InputBox("処理回数は？")」のように、汎用的な使い方にも対応できます。

実行した処理の内容を表示する

同じ処理を複数回繰り返すのではなく、いくつかの処理を続けて実行するケースでは、現在「何をしている」のかをユーザーに示すといいでしょう。この場合は、For Nextステートメントの中で1度だけLabelを書き換えるのではなく、実行する処理のたびに適当なメッセージを表示します。

Private Sub UserForm_Activate()
    Me.Repaint
    Label2 = "用紙の向きを設定しています"
    DoEvents
    ActiveSheet.PageSetup.Orientation = xlLandscape
    Label2 = "用紙の種類を設定しています"
    DoEvents
    ActiveSheet.PageSetup.PaperSize = xlPaperA4
    Label2 = "余白を設定しています"
    DoEvents
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.787)
        .RightMargin = Application.InchesToPoints(0.787)
        .TopMargin = Application.InchesToPoints(0.984)
        .BottomMargin = Application.InchesToPoints(0.984)
        .HeaderMargin = Application.InchesToPoints(0.512)
        .FooterMargin = Application.InchesToPoints(0.512)
    End With
    Unload Me
End Sub