ステータスバーをプログレスバーとして使用する

'//API(Sleep)を使用する
Public Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

'//ステータスバー表示用変数
'stsbar：処理分母(プログレスバーの細かさを指定)
'stsend：現在の処理数(初期値は0)
Private stsbar As Double
Private stsend As Double

'********************************************
'ステータスバーに進捗を表示するサンプル
'********************************************
Sub ステータスバーをプログレスバーとして使用する()
    '画面の描画が停止中（ScreenUpdating=False）のときの進捗表示の一例です
    '描画を停止中でもステータスバーでプログレスバーの代用ができます
    
    Dim sec As Integer
    Dim cnt1 As Integer '処理1の処理数(ファイル数などを設定)
    Dim cnt2 As Integer '処理2の処理数
    
    '//処理1、処理2の処理数をそれぞれ設定する
    '今回は処理1が完了したとき進捗20%、処理2が完了したとき進捗100%となるようにする
    '2つの処理数の分母(500)に対する配分は処理の重さ等からそれぞれ実装前に判断する
    cnt1 = 40
    cnt2 = 110
    
    '//ステータスバー表示用変数に値をセット
    'プログレスバーを500分割して管理(型Doubleを明示)
    stsbar = 500#
    'プログレスバーの現在の処理数(初期値は0)
    stsend = 0#
    
    '描画を停止
    Application.ScreenUpdating = False
    
    '処理開始メッセージを表示
    '第一引数に0をセットすると進捗(％)には影響を与えずメッセージ出力のみ
    SetStsbarItem 0, "プログラムを開始します..."
    Sleep 500
    
    '//時間のかかる処理を行う
    '処理1を開始
    '処理1完了時の全体進捗は20%、処理1自体の処理数は40がセットされている
    SetStsbarItem 0, "[処理1] 0/0処理1を開始します..."
    Sleep 500
    For sec = 1 To cnt1
        '//～時間のかかるいろいろな業務処理をここで行う～
        'プログラムの処理を80ミリ秒待つ(処理1の動作)
        Sleep 80
        
        'プログラムのループ1回分(50/cnt1)でステータスバーを更新
        '全体(stsbar=500)に対して処理1完了時は100進んでいればよい
        SetStsbarItem (100# / cnt1), "[処理1] " & CStr(sec) & "/" & CStr(cnt1 + cnt2) & "の処理が終了しました"
        DoEvents
    Next
    
    '処理2を開始
    '処理2開始時にはすでに20%(100/500)進んでいるため処理2では残り80%進めればよい
    '処理2完了時の全体進捗は100%、処理2自体の処理数は110がセットされている
    SetStsbarItem 0, "[処理2] " & CStr(cnt1) & "/" & CStr(cnt1 + cnt2) & "処理2を開始します..."
    Sleep 500
    For sec = 1 To cnt2
        '//～時間のかかるいろいろな業務処理をここで行う～
        'プログラムの処理を120ミリ秒待つ(処理2の動作)
        Sleep 120
        
        'プログラムのループ1回分(450/cnt1)でステータスバーを更新
        '全体(stsbar=500)に対して処理2で400(全体から処理1を引いた分)進んでいればよい
        SetStsbarItem (400# / cnt2), "[処理2] " & CStr(cnt1 + sec) & "/" & CStr(cnt1 + cnt2) & "の処理が終了しました"
        DoEvents
    Next
    
    'プログラム終了メッセージ
    SetStsbarItem 0, "プログラムが正常に終了しました"
    
    '描画を再開
    Application.ScreenUpdating = True
    'メッセージ表示
    MsgBox "処理が終わりました", vbInformation
End Sub

'********************************************
'プログラムの進捗を計算しステータスバーに表示
'　cnt：新たな処理数(分母stsbarに対する処理数)
'　strmsg：表示するメッセージ
'********************************************
Private Sub SetStsbarItem(ByVal cnt As Double, ByVal strmsg As String)
    stsend = stsend + cnt
    
    '100％を超えないように設定
    If stsend > stsbar Then stsend = stsbar
    'ステータスバーにメッセージを表示する
    SetStatusBar strmsg
End Sub
Private Sub SetStatusBar(ByVal strmsg As String)
    '終了時には「■」50文字が表示される
    Application.StatusBar = "処理中です... " & fmtSpace(CStr(Round(stsend / stsbar * 100, 0))) & _
                                "%" & String(Int(stsend / stsbar * 50#), "■") & "  " & strmsg
    Sleep 100
End Sub

'********************************************
'％表示をフォーマットする
'0%～100%(3桁)のとき桁を揃えて表示するため半角スペースをセット
'********************************************
Private Function fmtSpace(ByVal moji As String) As String
    '初期値をセット
    fmtSpace = moji
    If Len(moji) = 3 Then
        fmtSpace = "100"
    ElseIf Len(moji) = 2 Then
        fmtSpace = " " & moji
    ElseIf Len(moji) = 1 Then
        fmtSpace = "  " & moji
    End If
End Function