Access プログレスバー 画面固まる

質問

Access 2007 VBA でファイル出力処理が長いため、以下を参考にしてプログレスバーを設置しました。
http://www.moug.net/tech/acvba/0060023.htm

1,000件程度だと進行状況がちゃんと表示されるのですが、10,000件単位になるとAccess自体が応答せず、プログレスバーも途中で止まったまま、だけど処理は裏で動いているようでファイル出力自体は時間はかかりますがちゃんと出力されます。

DBアクセスを含んだファイル出力処理なので、多少時間がかかっているのかと思います。
また、私の技術の低さから処理自体に時間がかかってしまっていることもあると思いますが、私の技術では処理自体を変えて早くするのは限界です。

Access画面が固まらず、リアルタイムでプログレスバーを進行させる手段等ございましたらご教授いただけるとありがたいです。

回答No.1

DexMachina · ベストアンサー

プログレスバーは使ったことがないのですが・・・(汗)
(中間状況の表示が必要な場合は、それぞれの処理段階を示す意味も込めて、
　チェックボックスの「Off→Null→On」の表示切替で自作しているもので・・・)

> Access画面が固まらず、リアルタイムでプログレスバーを進行させる手段

ループ処理中の画面再描画の定番操作、DoEvents関数の組み込みという
ことになるかと思います。
http://office.microsoft.com/ja-jp/access/HA012288271041.aspx

但し、あまり高頻度に行うとスタックエラーを起こしますので、複数のループが
ある場合は、ある程度上位に入れるとか、カウントがある数の整数倍になった
ときだけ実行する、といった工夫をしてやる必要があります。

◆提示サイトのコードにDoEventsを組み込んだ例：

Private Sub コマンド1_Click()
　　Dim i As Integer
　　Dim PauseTime As Double

　　Me.Progress1.Max = 10
　　Me.Progress1.Min = 0

　　For i = Me.Progress1.Min To Me.Progress1.Max

　　　　'1回のループ毎にOSに処理を返す場合
　　　　DoEvents
　　　　'「i」が5の倍数(=5で割った余りが0)のときに実行させる場合
　　　　'If (i Mod 5)=0 Then DoEvents　　

　　　　Me.Progress1.Value = i

　　　　PauseTime = Timer + 1
　　　　Do While Timer < PauseTime '※1
　　　　Loop
　　Next
End Sub

お礼

ご回答ありがとうございます。

基本的な話だとは思いますが、
初心者の私に対して丁寧にご説明いただき、
本当にありがとうございます。

また、サンプルコードまで記載していただき、大変助かりました。

>(中間状況の表示が必要な場合は、それぞれの処理段階を示す意味も込めて、
>チェックボックスの「Off→Null→On」の表示切替で自作しているもので・・・)

できれば、こちらもご紹介いただけると幸いです。

本当にありがとうございました。

回答No.2

DexMachina

No.1です。

> できれば、こちらもご紹介いただけると幸いです。

・・・すみません、もしかしたら、いらないことを言ったかも(汗)
こちらでやっているのは、「必要時に、都度作成」なので、
「考え方」自体はともかく「プログラム」そのものは使いまわし
できません(汗)
(使い回せるようにできなくはないと思いますが、自分としては
　余り使用頻度が高くないので、「汎用ツール(?)として纏める
　苦労」より、「都度作成の労力」の方が小さい、と)

とはいえ、せっかくですので、雰囲気だけご紹介してみます。

◎フォームのプロパティシートでの設定
　※主に、ダイアログっぽい表示にするため。
『書式』タブ
　スクロールバー=なし
　レコードセレクタ=いいえ
　移動ボタン=いいえ
　区切り線=いいえ
　サイズ自動修正=はい
　自動中央寄せ=はい
　境界線スタイル=ダイアログ
　コントロールボックス=いいえ

『データ』タブ
　更新の許可=いいえ
　※チェックボックスの『使用可能』『編集ロック』の設定を
　　 個別に行うのが面倒な場合。

『イベント』タブ
　開く時=[イベント プロシージャ]
　タイマ時=[イベントプロシージャ]
　タイマ間隔=0
　※タイマ間隔(TimerInterval)は、『開く時』イベントで切替

『その他』タブ
　ポップアップ=はい
　作業ウィンドウ固定=はい

◎各チェックボックスのプロパティシート
『データ』タブ
　既定値=False
　使用可能=いいえ
　編集ロック=はい
　※マウスクリック等でフォーカスを受け付けない一方で、
　　 グレー表示にしないための設定。編集できなければ
　　 フォーカスは受け付けてもよしとするなら、フォームの
　　『更新の許可』を「いいえ」にすればOk。

◎フォームの『開く時』イベントのコード
Private Sub Form_Open(Cancel As Integer)

　　'フォームのコントロールが未表示のままでの処理開始を回避
　　Me.TimerInterval = 100

End Sub

◎フォームの『タイマ時』イベントのコード
Private Sub Form_Timer()
'エラー発生時は「エラー処理:」の行に飛ばす
On Error Goto エラー処理

　　'『タイマ時』イベントが繰り返されるのを回避
　　Me.TimerInterval = 0

　　'クエリ実行時などのメッセージ表示を回避
　　DoCmd.SetWarnings False

　　'別のデータベースの「MT1」テーブルをインポート
　　チェック1 = Null　　　'チェックボックスの表示を切替(クラシック表示ならグレー)
　　DoEvents
　　DoCmd.TransferDatabase acImport, "Microsoft Access", "c:\Source.mdb", acTable, "MT1", "NewMT1"
　　チェック1 = True　　'処理終了をチェックボックスに反映

　　'このデータベースの「MT1」を別のデータベースにエクスポート
　　チェック2 = Null
　　DoEvents
　　DoCmd.TransferDatabase acImport, "Microsoft Access", "c:\OldTables.mdb", acTable, "MT1", "MT1" & Date$
　　チェック2 = True

　　'古いデータを削除
　　チェック3 = Null
　　DoEvents
　　DoCmd.OpenQuery "MQ1_1_初期化"　　　'削除クエリ(MT1の全レコードを削除)
　　チェック3 = True

　　'「NewMT1」から必要なデータを「MT1」テーブルに抽出
　　チェック4 = Null
　　DoEvents
　　DoCmd.OpenQuery "MQ1_2_更新"　　　'更新クエリ(NewMT1から必要列のみ追加)
　　チェック4 = True

　　MsgBox "全ての工程を終了しました。", , "確認"

終了処理:
　　'メッセージ表示を復活
　　DoCmd.SetWarnings True
　　Exit Sub

エラー処理:
　　'エラーメッセージを表示して、処理を中止
　　MsgBox Err.Number & "：" & Err.Description, , "処理を中止しました。"
　　Resume 終了処理

End Sub

お礼

詳細な内容をご教授くださり、ありがとうございます。

後ほど試させていただきます。

質問に関してはこれで締め切らせていただきます。
本当にありがとうございました。