AccessVBAでシステム構築1 画面遷移のプログラミング

今回から『AccessVBAでシステム構築』と銘打ち、
うちの業務システムで実際に使われているVBAの共通関数をご紹介してみようと思う。

まず第1回目は『画面遷移のプログラミング』。


普通、A画面からB画面に移る場合、

DoCmd.OpenForm "formB"
DoCmd.Close acForm, "formA"


と記述することと思う。
しかし、本格的にシステムを組むと次のような問題点が起こる。

　　検索画面Aから一覧画面Bを表示し、選択を行って詳細画面Cに遷移。
　　しかし、検索画面Aには直接番号を指定して詳細画面Cに遷移することも可能。
　　その場合、詳細画面Cからの戻り先はＡの場合とBの場合があり、


　　DoCmd.Close acForm, "formA"

　　とも

　　DoCmd.Close acForm, "formB"

　　とも記述できず前の画面が何であったかを記憶して動的に戻す必要がある。

各種照会画面への縦横無尽な遷移を実現するために、こういった関数の必要性が出てくる。

それに毎度作りこんでいては保守性が低下する上に工数も増大してしまいます。


そこで、有限会社パーツでは、以下の３つの関数を使用しています。


■U_FormNext
次の画面に遷移する関数

■U_FormPrev
前の画面に戻る関数

■U_FormMenu
メニュー画面に戻る関数


これらの関数を利用して、

Ａ→Ｂ→Ｃ→Ｄ→Ｅ→Ｆ→Ｇ

Ａ→Ｅ→Ｇ

Ａ→Ｂ→Ｃ→メニュー

などの自由な画面遷移を行い、かつ保守性が低下することもありません。


次の画面に遷移する際に、現在の画面情報をテーブルに書き込み、戻りの際に最新のものを取り出して消すことで、網の目のように機能間をまたがった画面遷移も可能となります。First In First Out のスタック形式です。

そのテーブル構造は、

・テーブル名：tc50
・項目
・FormIndex　　 バイト型　主キー
・FormName　　テキスト型　フォーム名
・FormBatch　 テキスト型　バッチファイルによる画面起動の場合のバッチ名
・FormWhere テキスト型　一覧表示時の抽出条件
・FormParm テキスト型　受け渡しパラメタ
・FormBtnName テキスト型　戻りの際にフォーカスを当てたいボタン名
・FormDialog Yes/No型　ダイアログ形式でのオープン指定


としている。



それでは実際に関数を見ていくことにする。


■次の画面に遷移する関数

《使用方法》
次の画面へ行くボタンで関数を呼び出す。

Call U_FormNext(Me.Name, "formA", "", "", "", "")

　・抽出を行いたい場合
Call U_FormNext(Me.Name, "formA", "", "", "shouhin_no=100", "")

　・戻ってきたとき、フォーカスを「戻る」ボタンにしたい場合
Call U_FormNext(Me.Name, "formA", "", "", "", "modoru_btn")


Public Sub U_FormNext(ByVal I_CloseForm As String, _
ByVal I_NextForm As String, _
Optional ByVal I_Batch As String = "", _
Optional ByVal I_WHERE As String = "", _
Optional ByVal I_Parm As String = "", _
Optional ByVal I_FormBtnName As String)
'次のフォーム表示
Dim RS As ADODB.Recordset
Dim SQL As String
Dim wNextIndex As Integer
On Error GoTo Err_Handler
'次画面インデックスを取得
wNextIndex = DMax("tc050", "FormIndex") + 1

'画面遷移テーブル更新
SQL = "SELECT FormIndex, FormName, FormBatch, FormWhere, FormParm, FormBtnName FROM tc050;"

Set RS = New ADODB.Recordset
Call RS.Open(SQL, CurrentProject.Connection, adOpenDynamic, adLockPessimistic)
With RS
.AddNew
.Fields("FormIndex") = wNextIndex
.Fields("FormName") = I_NextForm
.Fields("FormBatch") = I_Batch
.Fields("FormWhere") = I_WHERE
.Fields("FormParm") = I_Parm
.Fields("FormBtnName") = I_FormBtnName
.Update
End With
Call RS.Close
Set RS = Nothing

'G_FORM_OLDはグローバル変数で、ひとつ前のフォーム名を格納する
　G_FORM_OLD = I_CloseForm
If I_CloseForm = I_NextForm Then
DoCmd.Close acForm, I_CloseForm, acSaveNo
End If

'次画面展開
If Nz(I_Batch, "") <> "" Then
Call Eval(I_Batch)
Else
DoCmd.OpenForm I_NextForm, , , I_WHERE, , acWindowNormal, I_Parm
End If

'特別パッチ（次の画面が同じ画面ではないとき（通常）、後で画面を閉じる）
If I_CloseForm <> I_NextForm Then
DoCmd.Close acForm, I_CloseForm, acSaveNo
End If
Exit Sub

Err_Handler:
MsgBox "コード：" & Err.Number & Chr(13) & Chr(10) & wErrMsg, vbCritical, "エラー処理"
End Sub


■ひとつ前の画面に遷移する関数

《使用方法》
ひとつ前の画面へ戻るボタンで関数を呼び出す。

Call U_FormPrev(Me.Name)


Public Sub U_FormPrev(ByVal I_CloseForm As String)
'ひとつ前の画面を表示
Dim RS As ADODB.Recordset
Dim SQL As String
Dim wPrevIndex As Integer

Dim FormPrevFRM As Form
Dim FormPrevCTL As Control
Dim wFormBtnName As String
Dim wFormName As String

On Error GoTo Err_Handler
wPrevIndex = DMax("FormIndex", "tc050") '最大番号

SQL = "SELECT * FROM tc050"
SQL = SQL & " WHERE FormIndex=" & wPrevIndex & ";"

Set RS = New ADODB.Recordset
Call RS.Open(SQL, CurrentProject.Connection, adOpenDynamic, adLockPessimistic)
If RS.EOF = False Then
wFormBtnName = Nz(RS!FormBtnName)
RS.Delete
Else
wFormBtnName = ""
End If
Call RS.Close
Set RS = Nothing

'前画面を格納
G_FORM_OLD = I_CloseForm

wPrevIndex = Nz(DMax("FormIndex", "tc050"), 0) '最大番号
If wPrevIndex = 0 Then
Call U_FormMenu(I_CloseForm)
DoCmd.Close acForm, I_CloseForm
Exit Sub
End If

SQL = "SELECT * FROM tc050"
SQL = SQL & " WHERE FormIndex=" & wPrevIndex & ";"

Set RS = New ADODB.Recordset
Call RS.Open(SQL, CurrentProject.Connection, adOpenDynamic, adLockPessimistic)
If RS.EOF = False Then
If Nz(RS!FormBatch) <> "" Then
Call Eval(RS!FormBatch)
Else
'特別パッチ（前の画面が同じ画面のとき（照会などで）、先に画面を閉じる）
wFormName = RS!FormName
If I_CloseForm = wFormName Then
DoCmd.Close acForm, I_CloseForm, acSaveNo
End If

DoCmd.OpenForm RS!FormName, , , Nz(RS!FormWhere), , acWindowNormal, Nz(RS!FormParm)
If wFormBtnName <> "" Then
Set FormPrevFRM = Forms(RS!FormName)
Set FormPrevCTL = FormPrevFRM.Controls(wFormBtnName)
FormPrevCTL.SetFocus
Set FormPrevFRM = Nothing
Set FormPrevCTL = Nothing
End If
End If
End If
Call RS.Close
Set RS = Nothing

'特別パッチ（前の画面が同じ画面ではないとき、先に画面を閉じる）
If I_CloseForm <> wFormName Then
DoCmd.Close acForm, I_CloseForm, acSaveNo
End If
Call U_HourglassOFF
Exit Sub

Err_Handler:
Select Case Err
Case 2110
Resume Next
Case Else
　　MsgBox "コード：" & Err.Number & Chr(13) & Chr(10) & wErrMsg, vbCritical, "エラー処理"
End Select
End Sub



■メニュー画面に戻る関数

《使用方法》
メニューへ戻るボタンで関数を呼び出す。

Call U_FormMenu(Me.Name)


Public Sub U_FormMenu(ByVal I_CloseForm As String)
'メニュー画面表示
Dim SQL As String

SQL = "DELETE FROM tc050;"
CurrentProject.Connection.Execute SQL

DoCmd.OpenForm "fMenu"
DoCmd.Close acForm, I_CloseForm

G_FORM_OLD = I_CloseForm
Call U_HourglassOFF
End Sub



■グローバル変数

モジュールに記述しておきます。

'*****************************************************
' SYSTEM グローバル変数定義
'*****************************************************
Public G_FORM As String
Public G_FORM_OLD As String



まだまだ改良の余地はあるが、現在の要件はこれですべてカバーできている。
将来的にはスタックテーブルをXMLに置き換える予定。