ステータスバーへの進捗表示(Excel)

Sub prcUpdateStatusBarEvery10Items()
    Dim i As Long
    Dim lngTotal As Long
    
    ' 例として100件の処理を想定
    lngTotal = 100
    
    ' 処理開始前にステータスバーをクリア
    Application.StatusBar = "処理を開始します..."
    
    For i = 1 To lngTotal
        ' ここで各項目に対する処理を行う
        ' (例: Workbooks(1).Sheets(1).Cells(i, 1).Value = "Test")
        
        ' 10件ごとにステータスバーを更新
        If i Mod 10 = 0 Then
            Application.StatusBar = "進捗: " & i & " / " & lngTotal & " 件処理済み..."
        End If
        
        ' デモ用の待機時間(実際のコードでは不要)
        Application.Wait (Now + TimeValue("0:00:01"))
    Next i
    
    ' 処理完了後にステータスバーをクリア
    Application.StatusBar = False
End Sub

コメント