「G01得意先マスタ登録」のVBAソースプログラム（プロシージャ）です
このプロシージャには研修用に説明を載せています。参考にしてください。
画面は「画面サンプル説明」- 「G01得意先マスタ登録」 を参照してください。
尚、このプログラムの説明依頼のメールはご遠慮ください。購入された方だけが対象です。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Compare Database ‘ Databaseモードでモジュールをはじめるための宣言 ☆必須項目
Option Explicit ‘ 変数に対し明示的な宣言を強制する（Dim等で宣言する） ☆必須項目
Dim Db As Database ' Databaseオブジェクトを宣言する
Dim Rs3 As Recordset ' 使用するテーブルのRecordsetオブジェクトを宣言する
Dim Rsa As Recordset ' Rsを頭に付けると区分しやすい 3桁目は任意にしている
' ここでは「A01得意先」に使用しているが、closeしたら、別のテーブルでも使える
' 変数の型を指定はモジュールの先頭でする
' （プロシージャ内だとそのプロシージャしか使いない）
Dim stDocName As String ' モジュール内で使用する変数の型を指定する（画面で使用する変数は指定不要）
' 標準モジュールで指定すると全てのモジュールで共通して利用できる
Dim strFilter As String ' 標準モジュール指定する時は Dim の代わりに Public を使用する‘==============================================================================================================
Private Sub Form_Open(Cancel As Integer)
‘Databaseオブジェクトをオープンする
Set Db = CurrentDb ‘ このモードで使うテーブルの前に Db. を付ける。 Set と Closeは対
Call ClearControlg ' このメニューの中で使う変数を初期化する。プロシージャ名の前に Call を付ける
' （画面のプロパティでも指定できるが、一覧で見た方が分かりやすい）End Sub
‘================================ <<<<< 印刷でプロシージャの境が分かりやすくするためのライン>>>>> ============
Private Sub 得意先コードAfterUpdate() ‘ 得意先コードを更新するとこのプロシージャ後が実行 On Error GoTo Err得意先コード_AfterUpdate ‘ このプロシージャ内でエラーが発生した時の飛び先
Me![得意先コード] = StrConv(Me![得意先コード], 1) ' 小文字を大文字に変換
'----マスタ登録の有無を確認
Set Rsa = Db.OpenRecordset("A01得意先", dbOpenDynaset) ' 使用するテーブルをオープンする
' SetとCloseは対で使う。 Form_Openで 記述するとずっとオープンしているので、他のPCがこの
' システムの同時使用すると非常に遅くなる。こまめにSetとCloseをする
Rsa.FindFirst "[得意先コード] = '" & Me![得意先コード] & "'" ' 入力したコードでデータを選択する
' 文字変数の時は、""で囲む。数字変数の時は Rsa.FindFirst "[得意先ID] = " & Me![得意先ID]
If Rsa.NoMatch = True Then ' このマスタコードがなかった時
'---新規
Me![モード] = "新規登録" ' 画面に「新規」か「修正」かを表示する
Me![PF6].Visible = False ' 画面に「PF6削除」を表示 しない
Else
'---変更 ' このマスタコードがあった時 （修正モード）
Call SetDataToControlg ' 画面に選択したデータを表示する
Me![モード] = "修正ﾓｰﾄﾞ"
'---「PF6削除」の表示
If Me![売上数] = 0 Then ' この得意先の売上伝票がない時
' （伝票がある得意先を削除すると、整合性が取れない）
' （Sub SetDataToControlg で検索している）
Me![PF6].Visible = True ' 画面に「PF6削除」を表示 する
Else
Me![PF6].Visible = False ' 画面に「PF6削除」を表示 しない
End If
End If
Rsa.Close ' 使用したテーブルを閉じる
'----------------------------------------- ' <<< 得意先コードに入力して開始した後の処理 >>>
Me![PF12].Visible = False ' 画面「PF12終了」の表示を消す
Me![PF2].Visible = True ' 画面に「PF2登録」を表示する
Me![PF5].Visible = True ' 画面に「PF5キャンセル」を表示する
Me![得意先コード].Locked = True ' この項目の使用をロックする。下の2行は無くても可‘ Me![得意先コード].Enabled = False ‘ この項目の使用を不可にする
‘ Me![得意先コード].TabStop = False ‘ この項目にカーソルが飛ばないようにする
Me![得意先名].SetFocus ' この項目にカーソルが移動する
Exit Sub ' このプロシージャの終了Err_得意先コード_AfterUpdate: ‘ このプロシージャ内でエラーが発生した時の受け先
MsgBox err.Description ‘ エラー内容を表示する
End Sub
‘==============================================================================================================
Private Sub 得意先コード_LostFocus() ‘ 得意先コードからカーソルが移動した直後の処理
Me![得意先コード] = StrConv([得意先コード], 1) ‘ 小文字を大文字に自動で変換する
End Sub ‘ エラーが発生した時の記述は無くてもOK
‘==============================================================================================================
Private Sub 得意先名_AfterUpdate()
Me![得意先略称] = Me![得意先名] ‘ 「得意先名」を「得意先略称」にコピーする
End Sub
‘==============================================================================================================
Public Sub PF2_Click()
‘——PF2 データ登録 ——-
On Error GoTo Err_PF2_Click ‘ エラーが発生したら、 Err_PF2_Click に飛ぶ
DoCmd.RunCommand acCmdSaveRecord ' 画面のデータをメモリに取り込む
' この行がないと、カーソルのあるデータは取り込めない‘ <<<<< 得意先コード_AfterUpdate で、Me![PF2].Visible = True を設定しているので下記記述は不要
” If IsNull(Me.得意先コード.Value) = True Then ‘ 「得意先コード」がブランクは登録しない
” Beep
” MsgCH = MsgBox(“得意先コードが登録されていません。”, vbOKOnly + vbCritical) ‘ OKだけ
” Me![得意先コード].SetFocus ‘ この項目にカーソルが移動する
” Exit Sub ‘ データを保管しないで、このプロシージャの終了
” End If
If IsNull(Me.得意先名.Value) = True Then ' 「得意先名」がブランクは登録しない
Beep
MsgCH = MsgBox("得意先名が登録されていません。", vbOKOnly + vbCritical)
Me![得意先名].SetFocus ' この項目にカーソルが移動する
Exit Sub ' データを保管しないで、このプロシージャの終了
End If
'---------------------------
Call PrS登録処理 ' データを保管する 登録処理
' （プロシージャを呼び出すときは先頭に call 付ける）
' call をつけなくても実行できるが、後でわかりにくい
Call ClearControlg ' 画面データを登録等をした後は、必ず変数を初期化する
Exit Sub ' このプロシージャの終了Exit_PF2_Click:
Exit Sub
Err_PF2_Click:
MsgBox err.Description ‘ エラーを表示する
Resume Exit_PF2_Click ‘ エラーが発生したら Exit_PF2_Click に飛ぶ
End Sub
‘==============================================================================================================
Private Sub PrS登録処理()
‘ プロシージャ名の前に Prsを付けるとわかりやすい （Prs以外でも、なんでもOK）
‘——– データを保管する —————–
Set Rsa = Db.OpenRecordset("A01得意先", dbOpenDynaset) ' 使用の都度オープンする
Rsa.FindFirst "[得意先コード] = '" & Me![得意先コード] & "'" ' 入力したコードがあるかを調べる
If Rsa.NoMatch = True Then ' このコードがない時
Rsa.AddNew ' 新規にレコードを作成する
Rsa![得意先コード] = Me![得意先コード] ' 入力した「得意先コード」を保管
Else
Rsa.Edit ' 更新の時は Edit を使う
End If
'..........
Rsa![得意先名] = Me![得意先名] ' 入力した各項目を保管
Rsa![得意先略称] = Me![得意先略称]
Rsa![カタカナ] = Me![カタカナ]
Rsa![郵便番号] = Me![郵便番号]
Rsa![住所1] = Me![住所1]
Rsa![住所2] = Me![住所2]
Rsa![TEL] = Me![TEL]
Rsa![FAX] = Me![FAX]
Rsa![携帯] = Me![携帯]
Rsa![メール] = Me![メール]
Rsa![備考] = Me![備考]
Rsa![担当ID] = Me![担当ID]
Rsa![得意先分類ID] = Me![得意先分類ID]
Rsa![掛率] = Me![掛率]
Rsa![締日] = Me![締日]
Rsa![回収月] = Me![回収月]
Rsa![回収日] = Me![回収日]
Rsa![税区分] = Me![税区分]
Rsa![税マルメ] = Me![税マルメ]
Rsa![税集計] = Me![税集計]
Rsa![端数処理] = Me![端数処理]
Rsa![区分1] = Me![区分1]
Rsa![区分2] = Me![区分2]
Rsa![区分3] = Me![区分3]
Rsa![取引停止] = Me![取引停止]
Rsa![レジ客] = Me![レジ客] '<<<<<<<<<<<<<A04レジ売上
Rsa![更新日付] = Date ' Date（本日）を保管する（作成日又は変更日）‘レコードの追加/更新を実施する
Rsa.Update ‘ テーブルに上記の項目データを書き込む
Rsa.Close ‘ 使用したテーブルを閉じる
Exit SubEnd Sub
‘==============================================================================================================
Public Sub PF5_Click()
‘——PF5 キャンセル ——-
On Error GoTo Err_PF5_Click
'-----------------
MsgCH = MsgBox("画面のデータを保存しないで、キャンセルしますか？", vbOKCancel + vbInformation)
'---(OKとキャンセルのボタン）、情報メッセージアイコン、デフォルトはOK
If MsgCH = vbOK Then
Call ClearControlg ' 画面データを初期化する
End If
Exit SubErr_PF5_Click:
MsgBox err.Description
End Sub
‘==============================================================================================================
Public Sub PF6_Click()
‘——PF6 データ削除 ——-
On Error GoTo Err_PF6_Click
'ＥＲＲ確認 <<<< 「PF6削除」は表示・非表示を設定しておくと、バグの発生が防げる
'--------- [売上数]が有れば「PF6削除」は非表示なので、このチェックは不要
' If Me![売上数] <> 0 Then ' この得意先の売上伝票がある時
' Beep
' MsgCH = MsgBox("★★★ 入力している売上伝票があります。削除できません。", 0 + 16 + 256)
' '---(OKのボタンだけ）、警告アイコン(+16)、デフォルトはキャンセル(+256)
' '--- 0:OKだけ 1:OKとキャンセル +16:警告 +48:注意 +64:情報
' Exit Sub
' End If
'--------- マスタ未登録では「PF6削除」は非表示なので、このチェックは不要
' If IsNull(DLookup("締日", "A01得意先", "[得意先コード] = '" & Me![得意先コード] & "'")) = True Then
' ' 「A01得意先」に画面の[得意先コード]があるかどうかを確認する
' ' 上記の PrS登録処理 のようにテーブルをオープンしなくても DLookup で簡単に確認できる
' ' 「締日」は数字項目なので必ずデータがある。「得意先名」等の文字はNullがあるのでダメ
'
' Beep ' エラー音を出す
' MsgCH = MsgBox("★★得意先が登録されていません★★", vbOKOnly + vbCritical)
' MsgCH = MsgBox("★★得意先が登録されていません★★", 0 + 16) ' 前記述と同じ
' （OKとキャンセル）等の選択はない。確認OKだけ記述しかない。
' Exit Sub
' End If
' 削除 の 確認 '---------- 下の2行は同じ内容です
' MsgCH = MsgBox("このデータを削除します。", 1 + 48 + 256, "削除の確認")
MsgCH = MsgBox("このデータを削除します。", vbOKCancel + vbExclamation + vbDefaultButton2, "削除の確認")
'------ MsgCH変数は標準モジュールのMeinモジュールで共通変数として指定している
' '------ (OKとキャンセルのボタン）、注意アイコン(+48)、デフォルトは2つ目の「キャンセル」(+256)
If MsgCH = vbCancel Then
Exit Sub
End If
'-------------------------------<<< 条件・範囲管理用のファイル(S99最終DRV) に条件を書く
Set Rs3 = Db.OpenRecordset("S99最終DRV", dbOpenDynaset)
Rs3.FindFirst "[ID] = 1"
Rs3.Edit
Rs3![R得意先コード] = Me![得意先コード]
Rs3.Update
Rs3.Close
' 「注意のメッセージ」を表示されると、入力担当者が困惑するため、無効にする
DoCmd.SetWarnings False ' 注意のメッセージ表示を無にする
DoCmd.OpenQuery "QG01削除_得意先", acNormal, acEdit ' このクエリーで指定の得意先を削除する
DoCmd.SetWarnings True ' 注意のメッセージ表示を有りに戻す
Call ClearControlg ' 画面データを初期化する
Exit SubErr_PF6_Click:
MsgBox err.Description
End Sub
‘==============================================================================================================
Public Sub PF12_Click()
‘——PF12 終了 ——-
On Error GoTo Err_PF12_Click
' 入力途中はＥＲＲ
If IsNull(Me.得意先コード.Value) = False Then
Beep
MsgCH = MsgBox("★★★ 入力途中です。", vbOKOnly + vbCritical)
Exit Sub
End If
'オブジェクトをクローズする
Db.Close ' データベースをクローズする
DoCmd.Close ' このプログラムを終了し、メニューに戻る
Exit SubErr_PF12_Click:
MsgBox err.Description
End Sub
‘==============================================================================================================
Public Sub ClearControlg()
‘—— 変数（コントロール）の値を初期化する ——-
Me![得意先コード] = Null
Me![得意先名] = Null ' 文字変数はブランク"" ではなく NUll にする
Me![得意先略称] = Null ' ""だと If IsNull(Me.得意先コード.Value) = True が使えない
Me![カタカナ] = Null
Me![郵便番号] = Null
Me![住所1] = Null
Me![住所2] = Null
Me![TEL] = Null
Me![FAX] = Null
Me![携帯] = Null
Me![メール] = Null
Me![担当ID] = 0
Me![得意先分類ID] = 1
Me![締日] = 31 ' デフォルト値は 0 でなくてもOK
Me![掛率] = 100
Me![税区分] = 1
Me![税マルメ] = 1
Me![税集計] = 1
Me![端数処理] = 1
Me![回収月] = 1
Me![回収日] = 31
Me![取引停止] = 0
Me![区分1] = 0
Me![区分2] = 0
Me![区分3] = 0
Me![備考] = Null
Me![レジ客] = 0 '<<<<<<<<<<<<<A04レジ売上
Me!モード = ""
'-------------------------------------
Me![PF12].Visible = True ' 画面「PF12終了」を表示する
Me![PF2].Visible = False ' 画面「PF2登録」の表示を消す
Me![PF5].Visible = False ' 画面「PF5キャンセル」の表示を消す
Me![PF6].Visible = False ' 画面「PF6削除」の表示を消す
Me![得意先コード].Locked = False ' この項目の使用ロックを解除する。下の2行は無くても可
' Me![得意先コード].Enabled = True
' Me![得意先コード].TabStop = True
Me![得意先コード].Requery ' 条件設定をクリアする
Me![得意先コード].SetFocus
'-------------------------------------End Sub
‘==============================================================================================================
Public Sub SetDataToControlg()
‘—— テーブルより選択したレコードの値を取り込む ——-
Me![得意先名] = Rsa![得意先名]
Me![得意先略称] = Rsa![得意先略称]
Me![カタカナ] = Rsa![カタカナ]
Me![郵便番号] = Rsa![郵便番号]
Me![住所1] = Rsa![住所1]
Me![住所2] = Rsa![住所2]
Me![TEL] = Rsa![TEL]
Me![FAX] = Rsa![FAX]
Me![携帯] = Rsa![携帯]
Me![メール] = Rsa![メール]
Me![担当ID] = Rsa![担当ID]
Me![得意先分類ID] = Rsa![得意先分類ID]
Me![締日] = Rsa![締日]
Me![掛率] = Rsa![掛率]
Me![税区分] = Rsa![税区分]
Me![税マルメ] = Rsa![税マルメ]
Me![税集計] = Rsa![税集計]
Me![端数処理] = Rsa![端数処理]
Me![回収月] = Rsa![回収月]
Me![回収日] = Rsa![回収日]
Me![取引停止] = Rsa![取引停止]
Me![区分1] = Rsa![区分1]
Me![区分2] = Rsa![区分2]
Me![区分3] = Rsa![区分3]
Me![備考] = Rsa![備考]
Me![レジ客] = Rsa![レジ客] '<<<<<<<<<<<<<A04レジ売上
'----- 選択した得意先の「D01売上伝票」の伝票数を調べる
Me![売上数] = DCount("[得意先コード]", "D01売上伝票", _
"[得意先コード] = '" & Forms![FG01得意先マスタ登録]![得意先コード] & "'")
' 記述が長い時は 半角スペースに続いて _ アンダーバーを付けて改行するEnd Sub
‘==============================================================================================================
Function iro(flg As Integer)
‘—— 画面のカーソルのある項目の色を黄色にする ——- 任意の画面のプログラムだけに指定している
‘—— 各コントロールのプロパティ イベントで設定する
‘—— 「フォーカス取得後」に「=iro(1)」を「フォーカス喪失時」に「=iro(0)」を設定する
‘—— 各項目の文字の色(ForeColor)や背景の色(BackColor)を指定する
With Screen.ActiveControl
Select Case flg
Case 0
‘.ForeColor = vbBlack ‘黒
.BackColor = 15263976 ‘白
Case 1
‘.ForeColor = vbWhite ‘白
.BackColor = 65535 ‘赤15138815 黄65535
End Select
End With
End Function