Accessで「お待ちください」メッセージフォームを表示するサンプル

Accessで長い処理を実行している間、なんの音沙汰もないと不安になります。
その対策として、実行中に「お待ちください」みたいなメッセージを表示すれば、ユーザーに少し安心してもらえるかなと思います。
そんな時のためのお待ちくださいフォームを作りました。
コピーしてそのまま使えるサンプルを紹介します。

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」に指定したフォーム名が存在するかチェックして、存在しなかった場合このプロシージャを抜けます。
フォームが存在する場合、第１引数が「True」だったらフォームを表示する方に、「False」だったらフォームを閉じる方に分岐します。

フォームを表示する方の処理でやっている事は、
フォームがまだ読み込まれていない場合、フォームの引数に当プロシージャの第２引数であるメッセージを渡してフォームを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のマクロからも下図のように呼び出すことができます。

Accessマクロからの呼び出し例

注意したいのは、クエリの実行を「DoCmd.OpenQuery」で記述しちゃうと、たしか非同期(だったと思う...)のため、クエリがまだ終わっていなくても終了メッセージまでいっきに進んでしまうかもしれないので気を付けて。

...とまあこんな感じで、お役に立てれば嬉しいです。

きなこSHOW

自作プログラム置き場です。