この続きですので、こちらからご覧ください
プログレスバーの追加
ユーザーフォームにプログレスバーを追加します
ツールボックス→その他のコントロール→Microsoft ProgressBar Controlに
チェックを入れます
追加したプログレスバーを選択し、ドラッグ
オブジェクト名：ProgressBar1
プログレスバーの表示
モーダレスでフォーム表示
frmTest.Show vbModeless
プログレスバーの最小値・最大値を代入
frmTest.ProgressBar1.Min = 0
frmTest.ProgressBar1.Max = 10000
プログレスバー表示
For i = 0 To 10000
frmTest.ProgressBar1.Value = i
Next i
時間の計測＆描画回数の変更
時間の計測
Dim StartT As Double
StartT = Timer
Call main ’メインの処理を呼び出す
MsgBox Timer – StartT & “秒 処理が終了しました”
処理にどれぐらいかかっているのか確認してみましょう！
描画回数の変更
毎回処理状況を描画するのではなく、例えば１０回に１回にしてみます
If i Mod 10 = 0 Then
i を10で割った余りが０の時だけ、描画する
プログレスバーを表示させると、処理時間が長くなるので
状況により回数を変更して、ベストな描画回数を探ってみましょう
For i = 0 To 10000
'10回に1回フォームを表示
If i Mod 10 = 0 Then
'OSに処理を返す(画面描画を更新)
DoEvents
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
End If
'時間のかかる処理はIF文の外に
Cells(8, 3) = i
Next i
仮想処理状況を表示するPG作成しました
main2で実行してください
あっという間に終わるので、描画回数の変更はしていません
mainは描画回数の変更するバージョンです
モードレスにしています
実行してみてください
フォーム
オブジェクト名：frmTest
Caption：実行中…
コマンドボタン
オブジェクト名：btnClose
Caption：閉じる
テキスト
オブジェクト名：txtJyoukyou
ラベル
オブジェクト名：lblJyoukyou
Caption：なし
オブジェクト名：変更なし
Caption：回目/10000回中
Module1
Option Explicit
Sub test()
'frmTest.Show vbModal 'モーダル(規定値)
frmTest.Show vbModeless 'モードレス
frmTest.ProgressBar1.Min = 0
frmTest.ProgressBar1.Max = 10000
Dim StartT As Double
StartT = Timer
'メインの処理を呼び出す
Call main2
'処理終了のメッセージを表示
MsgBox Timer - StartT & "秒 処理が終了しました。"
'フォームをアンロードする
Unload frmTest
End Sub
Sub main()
Dim i As Long
For i = 0 To 10000
'10回に1回フォームを表示
If i Mod 10 = 0 Then
'OSに処理を返す(画面描画を更新)
DoEvents
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
End If
'時間のかかる処理はIF文の外に
Cells(8, 3) = i
Next i
End Sub
Sub main2()
Dim i As Long
'ここにFile 読み込み処理を書く
Cells(8, 3) = "File 読み込み中"
frmTest.lblJyoukyou.Caption = "File 読み込み中"
For i = 1 To 3000
'OSに処理を返す(画面描画を更新)
DoEvents
Cells(10, 3) = i
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
'frmTest.Repaint '画面がちらつくのでコメントに
Next i
'ここに計算処理実行処理を書く
Cells(8, 3) = "計算処理実行中"
frmTest.lblJyoukyou.Caption = "計算処理実行中"
For i = 3001 To 7000
'OSに処理を返す(画面描画を更新)
DoEvents
Cells(10, 3) = i
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
'frmTest.Repaint '画面がちらつくのでコメントに
Next i
'ここにFile 書き込み処理を書く
Cells(8, 3) = "File 書き込み中"
frmTest.lblJyoukyou.Caption = "File 書き込み中"
For i = 7001 To 10000
'OSに処理を返す(画面描画を更新)
DoEvents
Cells(10, 3) = i
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
'frmTest.Repaint '画面がちらつくのでコメントに
Next i
frmTest.lblJyoukyou.Caption = "処理終了しました"
Cells(8, 3) = "処理終了しました"
End Sub
frmTest
Option Explicit
Private Sub btnClose_Click()
Dim CloseYesNo As Long
CloseYesNo = MsgBox("処理を中止しますか？", vbYesNo)
If CloseYesNo <> vbYes Then Exit Sub
Unload frmTest
End
End Subプログラムソース
YouTube動画のソースコードです
Sub test()
'frmTest.Show vbModal 'モーダル(規定値)
frmTest.Show vbModeless 'モードレス
'メインの処理を呼び出す
Dim i As Long
Dim StartT As Double
frmTest.ProgressBar1.Min = 0
frmTest.ProgressBar1.Max = 10000
StartT = Timer
For i = 0 To 10000
'10回に1回フォームを表示
If i Mod 10 = 0 Then
'OSに処理を返す(画面描画を更新)
DoEvents
frmTest.txtJyoukyou.Value = i
frmTest.ProgressBar1.Value = i
End If
'時間のかかる処理はIF文の外に
Cells(8, 3) = i
Next i
'処理終了のメッセージを表示
MsgBox Timer - StartT & "秒 処理が終了しました。"
'フォームをアンロードする
Unload frmTest
End Sub
Sub main()
'ここにメイン処理を書いてもOK！
End SubPrivate Sub btnClose_Click()
Dim CloseYesNo As Long
CloseYesNo = MsgBox("処理を中止しますか？", vbYesNo)
If CloseYesNo <> vbYes Then Exit Sub
Unload frmTest
End
End Sub
コメント