ACCESSのフォームについて

質問

ACCESS勉強中の若輩もんです。

今一つのテーブルに顧客の住所や電話番号など１５項目程度あります。
フォームで数人の入力作業員が打ち込んでいきます。
その中にツアーNo.というフィールドがありまして、それは一回フォームを開いて入力作業をしたらほとんど変わらず同じNo.を入れているのです。
作業の効率やミスを防ぐため、フォームを開く時にNo.を最初に入れるフォームを作り、一度の入力で顧客一人一人に反映させたいのです。

まだまだ初心者なので、ご教授お願いいたします。

回答No.4

noname#140971

Option Compare Database
Option Explicit

Private Sub Form_Load()
　　Me.ツアーNo_既定値 = DBLookup("ツアーNo_初期値", "各種設定", "ID=1")
　　Me.ツアーNo.DefaultValue = Me.ツアーNo_既定値
End Sub

Private Sub ツアーNo_既定値_AfterUpdate()
　　CnnExecute "UPDATE 各種設定 SET ツアーNo_初期値=" & Me.ツアーNo_既定値
　　Me.ツアーNo.DefaultValue = Me.ツアーNo_既定値
　　PauseMsg "[各種設定]![ツアーNo_既定値] を更新しました。", 2
End Sub

上記のやり方は、[各種設定]という様々な初期値等を記憶しておくテーブルを用意する方式。
フォームの起動時に[各種設定]に記憶された初期値を呼び出して表示します。
同時に関連するフィールドの既定値も更新します。
初期値が変更されたならば、[各種設定]を更新しメッセージで知らせます。

まあ、担当者が入れ替わろうが、途中でフォームを閉じようが同値の入力が保障されます。

さて、問題は、このやり方の実現の方法です。
僅か５行の VBAコードですが、なかなか難しいと思います。

Private Sub Form_Load()
　　Me.ツアーNo_既定値 = DLookup("ツアーNo_初期値", "各種設定", "ID=1")
　　Me.ツアーNo.DefaultValue = Me.ツアーNo_既定値
End Sub

DBLookup 関数を Access がサポートしている DLookup関数に変更しました。
多少、実行速度が遅くなりますが２行は実現ｄきました。

Private Sub ツアーNo_既定値_AfterUpdate()
　　CnnExecute "UPDATE 各種設定 SET ツアーNo_初期値=" & Me.ツアーNo_既定値
　　Me.ツアーNo.DefaultValue = Me.ツアーNo_既定値
　　MsgBox "[各種設定]![ツアーNo_既定値] を更新しました。"
End Sub

２秒経過したら自動的にメッセージを閉じる PauseMsg 関数も MsgBox 関数に変更。
多少、ユーザにとっては煩わしいですが、「そんなもん」と思ってもらうことにします。
さて、残るは CnnExecute 関数です。
これが無ければ、[各種設定]の更新も１行とはいきません。
そこで、 CnnExecute 関数だけは、以下に示しておきます。

Public Sub ErrMessage(ByVal CnnErrors As ADODB.Error, ByVal strSQL As String)
　　 MsgBox "ADOエラーが発生しましたので処理をキャンセルします。" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & CnnErrors.Description & Chr$(13) & _
　　　　　　"・Err.Number=" & CnnErrors.Number & Chr$(13) & _
　　　　　　"・SQL State=" & CnnErrors.SQLState & Chr$(13) & _
　　　　　　"・SQL Text=" & strSQL, _
　　　　　　vbExclamation, " ADO関数エラーメッセージ"
End Sub

Public Function CnnExecute(ByVal strSQL As String) As Boolean
On Error GoTo Err_CnnExecute
　　 Dim isOK As Boolean
　　 Dim cnn　As ADODB.Connection

　　 isOK = True
　　 Set cnn = CurrentProject.Connection
　　 With cnn
　　　　 .Errors.Clear
　　　　 .BeginTrans
　　　　 .Execute strSQL
　　　　 .CommitTrans
　　 End With
Exit_CnnExecute:
On Error Resume Next
　　 cnn.Close
　　 Set cnn = Nothing
　　 CnnExecute = isOK
　　 Exit Function
Err_CnnExecute:
　　 isOK = False
　　 If cnn.Errors.Count > 0 Then
　　　　 ErrMessage cnn.Errors(0), strSQL
　　　　 cnn.RollbackTrans
　　 Else
　　　　 MsgBox "プログラムエラーが発生しました。システム管理者に報告して下さい。(CnnExecute)", _
　　　　　　　　vbExclamation, " 関数エラーメッセージ"
　　 End If
　　 Resume Exit_CnnExecute
End Function