kokodayo.net Wiki

vba_進捗バー

Excel の Do Loop Until の処理で簡易進捗バーをステイタスバーに表示する

2006/07/12

 Private Sub 簡易進捗バー()
 'Copyright kokodayo.net Takakou_PCJ

Dim n As Long 'カウンタ変数
Dim x As Long  '処理総数

Dim bar1 As Single '進捗バー変数
Dim bar2 As Integer '進捗バー値保存用変数

  On Error GoTo Err 'エラー処理

  n = 1 'カウンター初期値定義
  x = 5000000 '処理数定義 (仮に5000000のとき)

  Do

    '--------------------
    '通常ここに処理がくる
    '--------------------

    bar1 = Int((n / x) * 10)
    If bar2 < bar1 Then
    Application.StatusBar = "処理中      " & String(bar1, "■") _
    & String(10 - bar1, "□")
    End If
    bar2 = bar1
    n = n + 1
 
  Loop Until n = x

    Application.StatusBar = "完了      " & String(10, "■")
 
    MsgBox ("終了しました。")
    
    Application.StatusBar = ""


  Exit Sub

Err:   'エラー処理

End Sub

改良点
進捗度が上がったときだけ加算するので、処理数が増えても
画面のちらつきがなくなり、処理に負担がかからなくなった。

kokodayo.net_VBA