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
コメント