【プログレスバー表示】

ここを編集

簡易版

Public Function UpdateProgressBar( _
    ByVal lPercent As Long _
)
    Dim lBlackBlkNum As Long
    Dim lWhiteBlkNum As Long
    Debug.Assert 0 <= lPercent And lPercent <= 100
    lBlackBlkNum = Int(lPercent / 10)
    lWhiteBlkNum = 10 - lBlackBlkNum
    Application.StatusBar = "処理中... " & String(lBlackBlkNum, "■") & String(lWhiteBlkNum, "□") & " " & lPercent & "%"
End Function
 
Public Function ClearProgressBar()
    Application.StatusBar = False
End Function
 

ラベルコントロール版

• https://github.com/draemonash2/codes/blob/master/vba/lib/ProgressBar.frm
• https://github.com/draemonash2/codes/blob/master/vba/lib/ProgressBar.frx

プログレスバーコントロール版

• プログレスバーのユーザーフォームを追加
• VBE ツール⇒その他のコントロール にて Microsoft ProgressBar Control を追加
  • 2014/05/20 追記：環境により動作しない場合があるため、本コードは使用しない！

Public IsProgCancel As Boolean
 
Private Sub CommandButton1_Click()
    IsProgCancel = True
End Sub
 

Sub test()
    Dim lTime As Long
    Dim iWaitTime As Long
 
    lWaitTime = 20000
 
    Call GenProgBar
 
    Call UpdateProgBar(10)
    For lTime = 0 To lWaitTime
        Call DoEventsProgBar
    Next lTime
    Call UpdateProgBar(50)
    For lTime = 0 To lWaitTime
        Call DoEventsProgBar
    Next lTime
    Call UpdateProgBar(100)
    For lTime = 0 To lWaitTime
        Call DoEventsProgBar
    Next lTime
 
    Call CloseProgBar
End Sub
 
'プログレスバーを生成
Public Function GenProgBar()
    ProgressBar.ProgressBar1.Min = 1
    ProgressBar.ProgressBar1.Max = 100
    ProgressBar.ProgressBar1.Value = 1
    ProgressBar.Show vbModeless
End Function
 
'プログレスバーの進捗を更新
Public Function UpdateProgBar( _
     ByVal sProgBarVal As String _
)
    ProgressBar.ProgressBar1.Value = sProgBarVal
End Function
 
'プログレスバーを閉じる
Public Function CloseProgBar()
    Unload ProgressBar
End Function
 
'キャンセルイベント受付
Public Function DoEventsProgBar()
    DoEvents
    If ProgressBar.IsProgCancel = True Then
        Unload ProgressBar
        MsgBox "キャンセルされました"
        End
    End If
End Function
 

ここを編集