Excel VBA プログレスバーをラベルに置き換えて表現する

進捗表示 プログレスバー ラベル表示 変更

過去記事「プログレスバーで進捗状況をビジュアルで表示する」で使ったActiveXの「プログレスバーコントロール」から、標準コントロールのラベルを使ったProgress表示に変更してみました。

くるみこ
くるみこ

前回までの記事で紹介した Label を使って表現するプログレスバーで「プログレスバーコントロール」と遜色のない表現が可能なことがわかりました。過去記事のコードを Label でProgress 表現するコードに変更してみましょう(^^)/

わかりました。よろしくお願いしますm(__)m

プログレスバーを標準コントロールで代用テストする記事がこちらです。

【この記事でわかることは】
・標準コントロールで代用する場合は参照設定は不要
・過去記事のコードを実際に変更したサンプルファイルをDLできるようにしています

スポンサーリンク

固定のプログレスバー用UserFormを使用する場合

あらかじめ Progress表示させる Label を配置したプログレスバー用UserFormを組み込んでおきます。

UserFormにプログレスバー用のレベルを配置

【動作の概要】は次のとおりです。
 時間のかかる作業開始 ⇒ 作業の進捗状況をプログレスバーで表示 ⇒ 作業完了 ⇒ 完了メッセージ(かかった作業時間や状況を表示)

【参照設定】は不要ですので、次の設定は解除してかまいません。
 Microsoft Windows Common Controls 6.0(SP6)

UserForm1 に設定したコード

Option Explicit
Public IsCancel As Boolean 'キャンセルボタン用フラグ
Private Sub UserForm_Initialize()
  Caption = "進捗状況"
  'フレームとラベルの位置は同一にする
  With Me.Label1
    .Left = 0
    .Top = 0
    .Width = 0
    .Visible = True
  End With
  'キャンセルフラグにFalseを設定
  IsCancel = False
End Sub
'キャンセルボタンクリックイベント
Private Sub CommandButton1_Click()
  'キャンセルフラグにTrueを設定
  IsCancel = True
End Sub

固定プログレスバー用UserFormに変更したコード

過去記事のコードはこのリンクから参照できます。
変数名やメッセージ表示などの部分を少し整理・変更しています。

Option Explicit
'貼付け元シート上で開始すること
'プログレスバーフォームを作成>表示>削除
Sub Array_match()
    Dim workSh As Worksheet, prefSh As Worksheet
    Dim sName As String
    Set prefSh = ThisWorkbook.ActiveSheet
    sName = prefSh.Range("K1").Value    '取得データ貼付け先シート名
    Set workSh = ThisWorkbook.Worksheets(sName)
    Dim ptCol As Long, pFlgCol As Long
    Dim pMCol As Long, pCol() As Long
    Dim wtCol As Long, wFlgCol As Long
    Dim wMCol As Long, wCol() As Long
    Dim pRow As Long, wRow As Long
    Dim i As Long
    
    '▼マーク(ターゲット)列を検索
    ptCol = Application.WorksheetFunction.Match("▼", prefSh.Rows(2), 0)
    wtCol = Application.WorksheetFunction.Match("▼", workSh.Rows(2), 0)
    '設定行の最大数
    pMCol = Application.WorksheetFunction.Max(prefSh.Rows(2))
    wMCol = Application.WorksheetFunction.Max(workSh.Rows(2))
    'データ開始列の設定
    pRow = prefSh.Range("G1")
    wRow = workSh.Range("G1")
    '設定の不整合を判定する処理
    If pMCol <> wMCol Then
        MsgBox "引き当てる列の数が不整合のため中止します!"
        Exit Sub
    End If
    ReDim pCol(1 To pMCol)  '指定列を代入する
    pFlgCol = 0 '指定列の配置が連続しているかどうか調べる「0」は連続
    For i = 1 To pMCol
        pCol(i) = Application.WorksheetFunction.Match(i, prefSh.Rows(2), 0)
        If i > 1 Then
            If pCol(i) <> pCol(i - 1) + 1 Then pFlgCol = 1 '連続していない場合「1」
        End If
    Next
    ReDim wCol(1 To wMCol)  '貼付け先も同様に調べる
    wFlgCol = 0
    For i = 1 To wMCol
        wCol(i) = Application.WorksheetFunction.Match(i, workSh.Rows(2), 0)
        If i > 1 Then
            If wCol(i) <> wCol(i - 1) + 1 Then wFlgCol = 1 '連続していない場合「1」
        End If
    Next
    Dim workShEndR As Long, prefShEndR As Long
    Dim tgetTmpR As Long, tmpStr As Variant '文字列の場合もあるのでVariantで
    '最終行取得
    workShEndR = workSh.Cells(Rows.Count, wtCol).End(xlUp).Row
    prefShEndR = prefSh.Cells(Rows.Count, ptCol).End(xlUp).Row
    Dim tgetRng As Range
    'ターゲット(ID)の列範囲をセット
    Set tgetRng = Range(prefSh.Cells(pRow, ptCol), prefSh.Cells(prefShEndR, ptCol))
    
    'オートフィルタが設定されていたら解除する
    If (workSh.AutoFilterMode = True) Then workSh.Rows(wRow - 1).AutoFilter
    '開始件数チェック
    If IsNumeric(Range("N1").Value) = True Then
        If Range("N1").Value > wRow Then wRow = Range("N1").Value
    End If
    
    Dim matchRng As Variant '行取得用
    Dim MyArray() As Variant '配列用

    '///プログレスバー用///
    Dim lngHcount As Long   'HIT件数カウント用
    Dim percent As Long
    Dim starttime As Single
    Dim myspeed As Single
    Dim strMsg As String    'メッセージ用
    Dim f As Long           'Frame1の幅
    Dim n As Long           'Loopカウンター
    Dim k As Long           '総件数
    
    Call マクロ開始
    
    lngHcount = 0           'ヒットカウント初期化
    starttime = Time        'タイマーセット
    
    With UserForm1
        .Show vbModeless            'Modelessで表示
        f = .Frame1.Width           'フレームの横幅取得
        'ターゲットID件数分のループ
        k = workShEndR - wRow + 1   '最終行-開始行+1
        n = 0                'カウンター初期化
        Do
            If n = k Then Exit Do   '全終了確認したら抜ける
            DoEvents                '途中で中断ができるように
            tgetTmpR = n + wRow
            tmpStr = workSh.Cells(tgetTmpR, wtCol).Value  '検索対象ID
            '発見できなかった場合エラーでマクロが停止するので制御する
            On Error Resume Next
            '対象IDコードを配列から検索
            matchRng = Application.WorksheetFunction.Match(tmpStr, tgetRng, 0)
            If Err <> 0 Then
                matchRng = ""       'ERRORの場合空白に
                Err.Clear
            End If
            If matchRng <> "" Then  '""なら何もしない
                matchRng = matchRng + wRow - 1 '開始行分をプラスする-1
                '配列のメモリ領域割り当て
                ReDim MyArray(1 To pMCol)
                If pFlgCol = 1 Then '不連続の場合ループ、連続の場合一括書込み
                    For i = 1 To pMCol
                        MyArray(i) = prefSh.Cells(matchRng, pCol(i)).Value
                    Next
                Else
                    MyArray() = prefSh.Range(prefSh.Cells(matchRng, pCol(1)), _
                                    prefSh.Cells(matchRng, pCol(pMCol))).Value
                End If
                If wFlgCol = 1 Then '不連続の場合ループ、連続の場合一括書込み
                    For i = 1 To wMCol
                        workSh.Cells(tgetTmpR, wCol(i)).Value = MyArray(i)
                    Next
                Else
                    workSh.Range(workSh.Cells(tgetTmpR, wCol(1)), _
                            workSh.Cells(tgetTmpR, wCol(pMCol))) = MyArray
                End If
                lngHcount = lngHcount + 1   'ヒット数カウントアップ
                Erase MyArray       '配列初期化
            End If
            n = n + 1               '処理数カウントアップ
            '///プログレスバーキャンセルボタン処理///
            If .IsCancel = True Then
                strMsg = "処理を中断しました。"
                Exit Do
            End If
            '//プログレスバーの値表示を更新//
            .Label1.Width = n * f / k   '件×最大Width÷総件数
            '//プログレスバーのLabel2表示を更新//
            percent = CInt(n / k * 100) '進捗率計算
            .Label2.Caption = percent & "%完了【処理件数: " & _
                            n & " / " & k & " 】" & _
                            "【HIT件数:" & lngHcount & "件】"
        Loop
    End With
    
    Call マクロ終了
    
    If n = k Then   '処理完了なら次のメッセージをセット
        myspeed = Time - starttime  '現在時刻-スタート時刻
        strMsg = "処理が完了しました!" & _
            "処理時間は" & Minute(myspeed) & "分" & _
            Second(myspeed) & "秒 でした" & vbCrLf & _
            "【データ更新件数は: " & lngHcount & " 件でした】"
    End If
    MsgBox strMsg, vbInformation, "処理状況メッセージ"
    'プログレスバーFormを閉じる(メッセージ前に閉じてもOK)
    Unload UserForm1
End Sub

・66行目以降が進捗状況をLabelを使ったプログレスバーとして動作させている部分です。

・83行目の f = .Frame1.Width で Frame1の幅を取得しています。
  Frame1の幅 = Label1の最大幅です。最大幅 = 100% ということです。

・87行目からのLoop処理を Do…Loop に変更しています(前回は For…Next 使用)

・130行目で、プログレスバーの値(横幅)を更新しています。

・133行目で、Label2 に表示する進捗状況の数値を更新しています。

実際の動作を確認します

データを別シートに引き当て入力している動作状況のGIF画像がこちらです。

ラベルで表現しているプログレスバーの動作GIF画像

画像にはちらつきが出ていますが、実際の動作では気にならない程度です。
リンク先にサンプルファイルを登録していますのでよければご利用ください。

プログレスバー用UserFormを動的に作成する場合

プログレスバー用のUserFormを動的に作成して実行することもできます。その場合の動作は次のとおりです。

時間のかかる作業開始 ⇒ プログレスバー用のUserFormを動的に作成 ⇒ 作業の進捗状況をプログレスバーで表示 ⇒ 作業完了 ⇒ 完了メッセージ ⇒ 動的UserFormを削除

【参照設定】に次の「VBEを操作するための拡張機能」を追加する必要があります。
 Microsoft Visual Basic for Applications Extensibility 5.3
C:\Program Files(x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB

VBEを操作するための拡張機能の参照設定画像

参照設定ができたら、次の設定も行う必要があります。

[ファイル]タブ > [Excel のオプション] > [トラストセンター] タブ > [トラストセンターの設定] > [マクロの設定] > [VBA プロジェクト オブジェクト モデルへのアクセスを信頼する] チェックボックスを選択 [✓] します。これを設定することで、VBAマクロから Visual Basic オブジェクト、メソッド 及び プロパティ にアクセスできるようになります。

VBA プロジェクト オブジェクト モデルへのアクセスを信頼する設定

この設定をせずに実行した場合、「実行時エラー’1004′ プログラミングによるVisual Basicプロジェクトへのアクセス権は信頼性に欠けます」というエラーメッセージが表示されます。

ただし、このオプションを設定した場合、セキュリティ上の危険が発生する可能性がありますので注意が必要です。

プログレスバー用 UserFormを動的に作成して表示するサンプルファイルもリンク先に登録しておきますのでご利用ください。

 

 

スポンサーリンク

まとめ(おわりに)

以上、「プログレスバーで進捗状況をビジュアルで表示する」の「プログレスバーコントロール」を使用したコードを、標準コントロールで表現するバージョンに変更してみました。

まとめと感想など

くるみこ
くるみこ

「プログレスバーコントロール」を使わないようにすることで、PCの環境によって動作しないなどということが無くなったと思います。

Frame と Label の幅が一緒なのがミソですね。Frame の幅が「プログレスバーコントロール」の Max にあたるということですね (^^)

【今回わかったことは】
・標準コントロールで代用する場合は参照設定は不要です
・動的 UserForm を使って動作させる場合は、参照設定とセキュリティの設定変更が必要なので注意が必要なことがわかりました


★★★ ブログランキング参加中! クリックしてね(^^)/ ★★★

【今後の記事について】

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてる」というポリシーで、記事を継続して書いていきたいと思っています。どうぞよろしくお願いしますm(_ _)m

【検討中の今後の記事内容は・・・・】
・実務に役立つものを提供できるよう常に検討しています(^^ゞ
・その他雑記的に「プチネタなど」もいろいろ考えていきたいと思っています・・・・
・今後の記事にご期待ください(^^)/

過去記事のサンプルファイルをダウンロードできます

リンク先に今回記事のサンプルファイルを登録しています
過去の記事で使用したサンプルファイルをダウンロードできるようにページを設置していますので、こちら(このリンク先)からご利用ください

おすすめ書籍はこちら
ユーザーフォーム
スポンサーリンク
\(この記事をシェアする)/
\( フォローする )/
関連記事
kurumico.com (^^)/