VBAでフォームを使う-2プログレスバーを作るコードを紹介＆解説

Option Explicit
'キャンセル処理用フラグ
Public IsCancel As Boolean

'初期化
Private Sub UserForm_Initialize()
'キャンセルフラグにFalseを設定
IsCancel = False
End Sub

'キャンセルボタンクリックイベント
Private Sub BtnCancel_Click()
'キャンセルフラグにTrueを設定
IsCancel = True
End Sub

Option Explicit
'いつもの様にあえて変数は日本語を使っています
Sub プログレスバー()
'**********************************************************************
'1_変数の定義
Dim 最終行 As Long
Dim 最終列 As Long
Dim 行 As Long
Dim 列 As Long

'フォームで使う変数
Dim percent As Long 'frmPBで使用　処理の進捗
Dim count As Long  'frmPBで使用　変数percentの分母
Dim p As Long: p = 1 'frmPBで使用　変数percentの分子
'**********************************************************************
Application.ScreenUpdating = False
'**********************************************************************
'2_データ範囲取得
最終行 = Cells(Rows.count, 2).End(xlUp).Row
最終列 = Cells(6, Columns.count).End(xlToLeft).Column
'**********************************************************************
'3_PB初期設定
'フォームで使う変数percentの分母に値をセット  変数の後のマイナスは開始列までの値
count = 最終列 - 1

'FrmPBを表示
frmPB.Show vbModeless

'フォームの表示位置を決める（適当）
frmPB.StartUpPosition = 0
frmPB.Top = 220
frmPB.Left = 550

'フォームの最小値を設定
frmPB.ProgressBar1.Min = 1
'フォームの最大値を設定
frmPB.ProgressBar1.Max = count
'フォームの現在値を設定
frmPB.ProgressBar1.Value = 1

'アイコンを待機中に固定
Application.Cursor = xlWait
'**********************************************************************
'4_ループ処理
'今回のコードはただセルを選択するだけ
'その間でキャンセルボタンが押された時の処理待ちや進捗の値を更新している
For 列 = 2 To 最終列
    For 行 = 6 To 最終行
        'セルを選択するだけ
        Cells(行, 列).Select

　　 '5_キャンセル処理と進捗確認
       '進行中の処理をキャンセルした時の処理とfrmPBに進捗度を表示させる為の処理
       '進行中の処理ををキャンセル 
        If frmPB.IsCancel = True Then
            'フォームを閉じる
            Unload frmPB
            'マウスカーソルをデフォルトに戻す
            Application.Cursor = xlDefault
            MsgBox "処理を中断しました"
            End
        '途中までの結果は無しにして処理を終了
        End If
　　　
        'frmPBに進捗度を表示
        If frmPB.ProgressBar1.Min <= p And _
        frmPB.ProgressBar1.Max >= p Then
            'フォームのLabel表示を更新
            percent = CInt(p / count * 100)
            frmPB.lbl1.Caption = percent & "%完了"
            'フォームの値を更新
            frmPB.ProgressBar1.Value = p
            'フォームに値をセットする為のコード
　　　　　   'コードの実行から一時抜けてVBA側に制御を戻して進捗表示をフォームに表示させる
            'DoEventsをどれだけ拾うかはデータ量次第で調整
            '以下コードは1列分の処理を終了したところでDoEventsが走る様に設定
            If 行 = 最終行 Then
                DoEvents
            End If
        End If
    Next
    p = p + 1
Next
'**********************************************************************
'6_後処理
'フォームを消す
Unload frmPB
'マウスカーソルをデフォルトに戻す
Application.Cursor = xlDefault
'**********************************************************************
Application.ScreenUpdating = True

MsgBox "作業完了", vbInformation, "確認"

End Sub