Access 得意先マスタ画面の VBA モジュールの設定を公開します。

お願い

似たようなページを数個作成していましたが、今後とも内容を充実するために似通ったページをまとめました。

恐れ入りますが、
Access 得意先マスタを VBA モジュールを使った開発方法を紹介します。
のサイトがまとめた最新ページです。今後はこちらのページを更新致しますので、宜しかったら移動をお願い致します。

今後とも宜しくお願い致します。

はじめに

今回は、自社で開発した社内システム「商助」の得意先マスタのモジュールの部分を説明して行きたいと思います。

ここで説明する内容は、BB が我流でやっている事であって、決してこれが正しいソフト開発方法です。とは言っていません。ただ、これまでこの方法でプロとしてやって来ましたので興味のある方は参考にされたらどうでしょうか。という気持ちで投稿しています。インデントは、3 です。WordPress では半角の空白が上手く表現できないため見にくいです。一旦メモ帳などにコピーして見やすいように整理して見て下さい。

可笑しな点や、もっといい方法もあるかも知れません。この点はご理解下さい。

又、どうしても理解できない。サポートして欲しい。という場合は、弊社の有料サポートにはなりますが、「Q&R」をご利用下さい。

得意先マスタ画面を「開く時」のモジュールの一部を表示します

Private Sub Form_Open(Cancel As Integer)
On Error GoTo ERR_Form_Open
  
Set DB01 = CurrentDb
 
得意先マスタの右側にボタンが並んでる部分の処理で BB 特有の作り方です。
  TK_XXX という基本テーブルから入力専用の TN_XXX テーブルを作成します。
  この TK_XXX テーブルは絶対に削除しません。
  下記は、たくさんの一時テーブル TN_XXX を一括して削除する時に使用します。
  ここでは、メモ、関連ファイルなどボタンを押した時に使用するファイルです。
   For IT01 = 0 To DB01.TableDefs.Count – 1
      If DB01.TableDefs(IT01).Name = “TN_URI” Then DoCmd.DeleteObject acTable, “TN_URI”
      If DB01.TableDefs(IT01).Name = “TN_KAK” Then DoCmd.DeleteObject acTable, “TN_KAK”

      ・・・・ 省略 ・・・
   Next
   一旦削除しましたが、入力用に再度、新しく作成します。

  SSQL = “SELECT * INTO TN_URI FROM TK_URI;”: DB01.Execute SSQL
  
SSQL = “SELECT * INTO TN_KAK FROM TK_KAK;”: DB01.Execute SSQL
  
SSQL = “SELECT * INTO TN_MEM FROM TK_MEM;”: DB01.Execute SSQL
      ・・・・ 省略 ・・・
 自由項目設定の処理
   SSQL = “SELECT * FROM TM_JSA;”
   Set DN01 = DB01.OpenRecordset(SSQL, DB_OPEN_DYNASET)
   If DN01.EOF Then
  
Else
     
設定している項目名(ラベル名)を代入し表示します。
     
Me.KMMST1 = IIf(IsNull(DN01!JSAMS1), “”, DN01!JSAMS1) マスタ項目1(マスタ項目2から6は省略)
     
Me.KMMOJ1 = IIf(IsNull(DN01!JSAMJ1), “”, DN01!JSAMJ1) ‘文字項目1(文字項目2から3は省略)
  Me.KMSUT1 = IIf(IsNull(DN01!JSAST1), “”, DN01!JSAST1) ‘数値項目1(数値項目2から3は省略)
     
Me.KMHDK1 = IIf(IsNull(DN01!JSAHD1), “”, DN01!JSAHD1) ‘日付項目1
日付項目2から3は省略)
  ラベル名が設定された項目は、入力出来るが、ラベル設定が無い項目は入力出来ない。
     
If Len(Trim(DN01!JSAMS1)) = 0 Or IsNull(DN01!JSAMS1) Then マスタ項目(2から6は省略)
        
Me.TOKMS1.Enabled = False
      Else
         Me.TOKMS1.Enabled = True
      End If
      If Len(Trim(DN01!JSAMJ1)) = 0 Or IsNull(DN01!JSAMJ1) Then ‘文字項目(2と3は省略)
        
Me.TOKMJ1.Enabled = False
      Else
         Me.TOKMJ1.Enabled = True
      End If
  数値項目 文字項目を同じ要領なので1から3を省略します。
  日付項目 文字項目を同じ要領なので1から3を省略します。
  
End If
  
DN01.Close
 
営業所マスタから営業所名を読込、表示します。
 Me.TOKEGN = DLookup(“EGSNME”, “TM_EGS”, “EGSCOD='” & Me.TOKEGC & “‘”)  ‘営業所名
 F05ファンクションキーや、ボタンを押した時と同じで、全ての入力された値をクリアーにして画面を初期状態にする。
 
F05_Click
EXIT_Form_Open:
 Exit Sub
ERR_Form_Open:
 Resume EXIT_Form_Open
End Sub

得意先マスタの「日付欄の更新後処理」のイベント プロシージャ

変数名 TOKTRB は、得意先:TOK 登録:TR 日:B のように名前を付けています。最初と最後の青色部分は、エラー処理部分です。

Private Sub TOKTRB_AfterUpdate()  
On Error GoTo ERR_TOKTRB_AfterUpdate
   If IsNull(Me.TOKTRB) Then
  ここでは、空白になったら今日の日付を登録日として代入します。

      Me.TOKTRB = Format(Date, “yy/mm/dd”)
   Else
  部品を使って 1、1/15、10/5、10/15 などの値を yy/mm/dd に変換します。

      Me.TOKTRB = TDBHDKNRK(Me.TOKTRB)
   End If
EXIT_TOKTRB_AfterUpdate:
   Exit Sub
ERR_TOKTRB_AfterUpdate:
   MsgBox Err.Description:Resume EXIT_TOKTRB_AfterUpdate
End Sub

今日が、2017/11/30 として、得意先の新規登録時に、登録日は、17/11/30 と表示されます。

ここで、日付を 17/11/15 に変更したい場合は、15 + Enter、17/10/25 に変更したい場合は、10/25 + Enter と簡単に入力が行えるようにした部品です。

殆どのシステムで日付入力があります。お客様の要望に合わせて西暦表現と和暦表現を作成しておけば開発がとても楽になり良いですよ。

部品名 TDB:テクノデービー HDK:日付関連 NRK:入力用 の意味です。

Function TDBHDKNRK(PR01 As String)
On Error GoTo ERR_TDBHDKNRK
   ‘日付の入力 1、12、3/1、4/23などを現在日付に変換する
   Dim HIDK As String, ST01 As String
 
TDBHDKNRK = 1
   HIDK = Format(Date, “yy/mm/dd”)
 値が、1 から 9 までの数字の場合

   If Len(LTrim(RTrim(PR01))) <= 2 Then
      ST01 = Left(HIDK, 6) + Right(“00” + Trim(PR01), 2)
   End If
 
If Len(Trim(PR01)) = 3 Then
      値が3桁の文字で、1/1 などの値

      If Mid(PR01, 2, 1) = “/” Then
         月、日が 1 桁の場合は、0 を加えて 2 桁にし、17/10/30 のようにする

         ST01 = Left(HIDK, 3) + Right(“00” + Left(PR01, 1), 2) + “/” + Right(“00” + Right(PR01, 1), 2)
      End If
   End If
   If Len(Trim(PR01)) = 4 Then
     
If Mid(PR01, 2, 1) = “/” Then
    値が 4 桁で、1/15

         ST01 = Left(HIDK, 3) + Right(“00” + Left(PR01, 1), 2) + Right(PR01, 3)
      Else
         値が 4 桁で、10/1 

         ST01 = Left(HIDK, 3) + Left(PR01, 3) + Right(“00” + Right(PR01, 1), 2)
      End If
   End If
  
If Len(Trim(PR01)) = 5 Then
      値が 5 桁で、10/30 のような日付
      ST01 = Left(HIDK, 3) + Right(PR01, 5)
   End If
   If Len(Trim(PR01)) = 8 Then
      直接 17/10/30 の入力

      ST01 = PR01
   End If
   この当時は、1900 年から 2000 年の2つが発生していたからの処理、今では不要

   IT01 = IsDate(IIf(Left(ST01, 1) > “5”, “19”, “20”) + ST01)
   If IT01 = 0 Or Len(ST01) <> 8 Then
      ERMD = MsgBox(“日付入力が正しくありません。”, 16, “日付/時間の確認”)
      Exit Function
   Else
      If CVDate(ST01) + 180 < Date Then
         MsgBox (“入力された日付が極端に古い日付です。間違いないか確認をして下さい。”)
      End If
  受けた時のパラメータに値を返す

      TDBHDKNRK = ST01
   End If
EXIT_TDBHDKNRK:
   Exit Function
ERR_TDBHDKNRK:
   MsgBox Err.Description:Resume EXIT_TDBHDKNRK
End Function

Access95 時代からたくさんのアプリを作りましたので、その時代の部品だと思います。気づいた部分は適当に変更して活用して下さいネ。

この後の処理も続きます。