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

0

    <機能>
    (1)画面の描画が停止中(ScreenUpdating=False)でも進捗表示を行う
    (2)2つの処理(処理1、処理2)それぞれの配分に応じて進捗を表示する
    (3)進捗(プログレスバー)の細かさを設定できる

    <使い方>
    (1)Workbook_OpenにApplication.StatusBar = Falseをセット(1~8行)
    (2)10行目以降を適当なところに張り付けて「ステータスバーをプログレスバーとして使用する()」を呼び出してください

    <イメージ>
    ステータスバーをプログレスバーとして使用できます
    ステータスバーをプログレスバーとして使用する、StatusBar、VBA

     

    '********************************************

    'ワークブックオープンイベント

    'ThisWorkbookに貼り付ける

    '********************************************

    Private Sub Workbook_Open()

        'エクセルがステータスバーを使えるように開放(プログレスバーとして使用するため)

        Application.StatusBar = False

    End Sub

     

    '********************************************

    'ここから先を適当なところに張り付ける

    '********************************************

    '//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:表示するメッセージ

    '********************************************

    Public 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

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    2627282930  
    << November 2017 >>

    profile

    others

    mobile

    qrcode