Accessで長い処理を実行している間、なんの音沙汰もないと不安になります。
その対策として、実行中に「お待ちください」みたいなメッセージを表示すれば、ユーザーに少し安心してもらえるかなと思います。
そんな時のためのお待ちくださいフォームを作りました。
コピーしてそのまま使えるサンプルを紹介します。
Accessのツールを他の人に使ってもらうときは、けっこう気を使います。
そもそもクエリの書き方に気を付けて、遅くならないようにするのはもちろんですが、それでも処理に時間がかかってしまう時の対策として、実行中はメッセージを表示して、終わったら消す、みたいなユーザーフォームを使っています。
進行状況をプログレスバーで表示したりとか複雑なことは一切しません。
クエリを実行する前にメッセージを表示して、終わったら閉じるだけの
シンプルなフォームです。
設計
お待ちくださいメッセージフォーム
今回は、Accessのフォーム1本と、標準モジュール1本の構成です。
まずは、フォームオブジェクトの設定から。
完成図
フォーム名:F_PleaseWait
フォーム名はご自分の命名規則に合わせて変えてくださいませ。
詳細セクションにラベルコントロールをひとつ配置しておきます。
フォームデザイン
[書式] | |
---|---|
標題 | (空白) |
既定のビュー | 単票フォーム |
レコードセレクタ | いいえ |
移動ボタン | いいえ |
区切り線 | いいえ |
スクロールバー | なし |
コントロールボックス | はい |
閉じるボタン | はい |
最小化/最大化ボタン | なし |
[データ] | |
レコードソース | (空白) |
[イベント] | |
開く時 | [イベント プロシージャ] |
[その他] | |
ポップアップ | はい |
作業ウィンドウ固定 | はい |
フォームのサイズはお好きにどうぞ。
ラベルのプロパティ
名前 | lblMsg |
---|---|
標題 | "実行中..." (改行)(改行) "しばらくお待ちください" |
ラベル名もご自分の命名規則に合わせて変更可能。
フォーム名やコントロール名を変更した場合、
以下のソースコード内のコントロール名もそれに合わせて読みかえてください。
サンプルコード
フォームデザインが終わったら[F7]でVBEに切り替えて、次の処理を記述します。
フォームモジュール
フォームモジュールに以下を記述します。
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
If Not IsNull(cgs_TOOLTITLE) Then
Me.Caption = cgs_TOOLTITLE
End If
If Not IsNull(Me.OpenArgs) Then
Me.lblMsg.Caption = Me.OpenArgs
End If
End Sub
Public Sub FncDispMessage(Optional ByVal vsMsg As Variant = Null)
On Error Resume Next
If Not IsNull(vsMsg) Then
Me.lblMsg.Caption = vsMsg
Me.Repaint
End If
End Sub
フォームを開く時のイベント「Form_Open」では、
まずフォームの標題=タイトルバー文字列にツールのタイトルをセットしているのと、
開く時に引数が渡された場合、それをラベル「lblMsg」の標題にセットします。
引数が渡されない場合は、フォームデザイン時に設定した標題のままフォームを表示します。
Publicプロシージャの「FncDispMessage」では、
引数で受け取ったメッセージの内容をラベルの標題にセットし、フォームを再描画します。
フォームの設定は以上です。
標準モジュール側のソースコード
メッセージを渡してフォームを開いたり閉じたりするためのプロシージャは、標準モジュールに記述します。
これをフォームモジュールに書いてしまうと動かないので、必ず標準モジュールに書いてください。
Option Explicit
Public Const cgs_TOOLTITLE As String = "Sample Tool" 'ツールのタイトル
Public Const cgs_FORM_WAIT As String = "F_PleaseWait" 'フォームオブジェクト名
'===========================================================================
'機能 :お待ちくださいメッセージフォームを表示する
'引数 :
' :vbShow (I ) Boolean True:表示
' :vsOpenArgs (I ) Variant メッセージ文言
'戻り値:True = OK, False = NG
'作成 :2016/08/24 kinaccco
'更新 :
'***************************************************************************
Public Function FncShowWaitMsg(Optional ByVal vbShow As Boolean = False, _
Optional ByVal vsOpenArgs As Variant = "") As Boolean
On Error GoTo Exit_Sec
Dim bRet As Boolean
Dim bHit As Boolean
Dim bIsLoaded As Boolean
Dim objDB As Object
Dim objForm As AccessObject
bRet = False
bHit = False
bIsLoaded = False
'--- オブジェクト存在チェック ---
Set objDB = Application.CurrentProject
For Each objForm In objDB.AllForms
If objForm.Name = cgs_FORM_WAIT Then
bHit = True
bIsLoaded = objForm.IsLoaded
Exit For
End If
Next
If Not bHit Then GoTo Exit_Sec
'--- フォームを開くor閉じる ---
If vbShow Then
Select Case True
Case Not IsMissing(vsOpenArgs) And Not bIsLoaded
DoCmd.OpenForm FormName:=cgs_FORM_WAIT, View:=acNormal, OpenArgs:=vsOpenArgs
Case Not IsMissing(vsOpenArgs) And bIsLoaded
Call Form_F_PleaseWait.FncDispMessage(vsOpenArgs)
Case IsMissing(vsOpenArgs) And Not bIsLoaded
DoCmd.OpenForm FormName:=cgs_FORM_WAIT, View:=acNormal
Case IsMissing(vsOpenArgs) And bIsLoaded
Call Form_F_PleaseWait.FncDispMessage
End Select
DoCmd.RepaintObject ObjectType:=acForm, ObjectName:=cgs_FORM_WAIT
Application.Screen.MousePointer = 11
Else
Application.Screen.MousePointer = 0
DoCmd.Close acForm, cgs_FORM_WAIT
End If
bRet = True
Exit_Sec:
On Error Resume Next
Set objForm = Nothing
Set objDB = Nothing
FncShowWaitMsg = True
End Function
宣言セクションにグローバル定数「cgs_TOOLTITLE」と「cgs_FORM_WAIT」を定義しています。
「cgs_FORM_WAIT」の値には、上で作ったフォームオブジェクト名を入力します。
「cgs_TOOLTITLE」の文言は任意で、ご自分のツールのタイトルを入力したり、「インポート処理」など、適宜変更してください。
次にPublicプロシージャの「gWaitMsg」では、
CurrentProject内のすべてのフォームから定数「cgs_FORM_WAIT」に指定したフォーム名が存在するかチェックして、存在しなかった場合このプロシージャを抜けます。
フォームが存在する場合、第1引数が「True」だったらフォームを表示する方に、「False」だったらフォームを閉じる方に分岐します。
フォームを表示する方の処理でやっている事は、
フォームがまだ読み込まれていない場合、フォームの引数に当プロシージャの第2引数であるメッセージを渡してフォームをOpenします。
フォームがすでに読み込まれている場合、フォーム側の「FncDispMessage」にメッセージを渡して呼び出します。
どちらの場合も、マウスポインタに砂時計ポインタを表示します。
フォームを閉じる方の処理では、マウスポインタを標準に戻し、フォームを閉じています。
呼び出し例
クエリ名「q_nageee」を実行するときはこんな感じに記述します。
Dim vWaitMsg As Variant
'--- 月次更新 開始 ---
vWaitMsg = "月次更新 実行中..." & vbCrLf & vbCrLf & "しばらくお待ちください"
Call FncShowWaitMsg(True, vWaitMsg)
'--- 時間のかかる処理 ---
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("q_nageee")
qdf.Execute
'--- 月次更新 終了 ---
Call FncShowWaitMsg(False)
MsgBox "正常終了しました!"
フォームを開くのも閉じるのも、メッセージを設定するのもすべてグローバルプロシージャ「FncShowWaitMsg」を使っています。
さいごにおまけ
Access「マクロ」からモジュールを実行できる
グローバルプロシージャなので、Accessのマクロからも下図のように呼び出すことができます。
注意したいのは、クエリの実行を「DoCmd.OpenQuery」で記述しちゃうと、たしか非同期(だったと思う...)のため、クエリがまだ終わっていなくても終了メッセージまでいっきに進んでしまうかもしれないので気を付けて。
...とまあこんな感じで、お役に立てれば嬉しいです。