Excel VBAメモ プログレスバー

ユーザーフォームによるプログレスバー

ユーザーフォーム以外に
Application.StatusBar も併用して
ステータスバーでのメッセージ更新している。

参考：https://kowaza.withinit.com/vba/vba_ProgressBarForm.html

GUIイメージ

コード1 UserForm1

'キャンセル処理用フラグ
Public IsCancel As Boolean

'初期化
Private Sub UserForm_Initialize()
'キャンセルフラグにFalseを設定
    IsCancel = False
End Sub

'キャンセルボタンクリックイベント
Private Sub BtnCancel_Click()
'キャンセルフラグにTrueを設定
    IsCancel = True
End Sub

コード　標準モジュール

'参考   https://kowaza.withinit.com/vba/vba_ProgressBarForm.html

Option Explicit

Public g_progressMax As Long
Public g_progressCnt As Long

'事前にUserFormを作成しておく
'　ツール⇒その他のコントロールより、Microsoft ProgressBar Control を選択して追加。


'実行ボタンClickイベント
Sub sub_run_progressBar()

    Dim i As Long
    Dim sum As Long
    Dim percent As Integer
    Dim tmp_flag As Integer
    
    g_progressMax = CLng(4) * CLng(10000)   'Clng付けないとオーバーフローする
    g_progressCnt = 0
    

    'プログレスバーFormを表示
    UserForm1.Show vbModeless
    'プログレスバーの最小値を設定
    UserForm1.ProgressBar1.Min = 1
    'プログレスバーの最大値を設定
    UserForm1.ProgressBar1.Max = g_progressMax
    'プログレスバーの現在値を設定
    UserForm1.ProgressBar1.Value = 1
    
    'DoEventsの度にマウスカーソルがちらつく為アイコンを待機中に固定
    Application.Cursor = xlWait
    
    'ステータスバーのメッセージ更新
    Application.StatusBar = "処理進行中 STEP 1/4 "
    
    '時間の掛かる処理を行う
    For i = 0 To g_progressMax / 4
        sum = sum + i
        
        'キャンセルボタン処理
        If UserForm1.IsCancel = True Then
            Call sub_cancel_progressBar
            Exit Sub
        End If
            
        'STEP1
        'プログレスバーの値表示を更新
        If UserForm1.ProgressBar1.Min < i And UserForm1.ProgressBar1.Max >= i Then
            'プログレスバーのLabel表示を更新
            g_progressCnt = g_progressCnt + 1
            percent = CInt(g_progressCnt / g_progressMax * 100)
            UserForm1.Label1.Caption = percent & "%完了 実行中 STEP1/5 "
            'プログレスバーの値を更新
            UserForm1.ProgressBar1.Value = g_progressCnt
            '他のイベントを処理できるようにする ユーザー操作など
            DoEvents
        End If
    
    Next
    
    'ステップ2
    tmp_flag = func_test1(2)
    If tmp_flag = 0 Then
        '終了処理
        Call sub_end_end_progressBar
        Exit Sub
    End If
    
    'ステップ3
    tmp_flag = func_test1(3)
    If tmp_flag = 0 Then
        '終了処理
        Call sub_end_end_progressBar
        Exit Sub
    End If
    
    'ステップ4
    tmp_flag = func_test1(4)
    If tmp_flag = 0 Then
        '終了処理
        Call sub_end_end_progressBar
        Exit Sub
    End If
    
    
    '結果をセルに表示
    ActiveSheet.Cells(1, 1).Value = g_progressCnt
    'プログレスバーFormを閉じる
    Unload UserForm1
    'マウスカーソルをデフォルトに戻す
    Application.Cursor = xlDefault
    
End Sub


Sub sub_cancel_progressBar()
    'キャンセルボタン処理
    'If UserForm1.IsCancel = True Then
        'プログレスバーFormを閉じる
        Unload UserForm1
        'マウスカーソルをデフォルトに戻す
        Application.Cursor = xlDefault
        MsgBox "処理を中断しました。"
        '※今回はロールバック処理を考慮せずにバッサリ処理を終了しています。
    'End If
End Sub


Sub sub_end_end_progressBar()
    '結果をセルに表示
    ActiveSheet.Cells(1, 1).Value = g_progressCnt
    'プログレスバーFormを閉じる
    Unload UserForm1
    'マウスカーソルをデフォルトに戻す
    Application.Cursor = xlDefault
End Sub

Function func_test1(in_step As Long) As Integer
    '返り値　正常終了なら 1, 途中中断などの場合は 0

    Dim i As Long
    Dim sum As Long
    Dim percent As Integer
    
    DoEvents
    
   
    '時間の掛かる処理を行う
    'プログレスバーのラベル
    UserForm1.Label1.Caption = "実行中 STEP" & in_step & "/4 "
    
    For i = 0 To g_progressMax / 4
        sum = sum + i
    
        'キャンセルボタン処理
        If UserForm1.IsCancel = True Then
            Call sub_cancel_progressBar
            func_test1 = 0
            Exit Function
        End If
        
        '他のイベントを処理できるようにする ユーザー操作など
        DoEvents
    Next
        
    
    'プログレスバーの値を更新
     g_progressCnt = g_progressCnt + (g_progressMax / 4)
    UserForm1.ProgressBar1.Value = g_progressCnt
    
    'ステータスバーのメッセージ更新
    Application.StatusBar = "処理進行中 STEP" & in_step & "/4 "
    
        
    func_test1 = 1  '返り値
    
End Function