広告 在庫管理

在庫管理システム－マスタ

2022年10月15日

品目マスタ

フォーム・F_品目マスタ

品目の基本情報（マスタ）を編集したいときがきます。そのためのフォームを作ります。
上半分にテキストボックスを、下半分にサブフォーム（テーブル品目を選択）を配置していきます。
フォームの【レコードソース】にテーブルを割り当てるのではなく、テキストボックスをサブフォームのテキストボックスに合わせていきます。
サブフォームの項目の分だけ上半分にテキストボックスとチェックボックスを配置します。

テキストボックスとサブフォームのテキストボックスの関連付け

上半分のテキストボックスの【プロパティ】の【データ】にて、【コントロールソース】の右端の【…】をクリックします。
（下図はコンボボックスになっておりますが、テキストボックスも同様です。）

下記のように、サブフォーム－フィールド－＜値＞とし、＜値＞のところでダブルクリックします。

テキストボックスには

=[品目のサブフォーム].[Form]![品目コード]

という具合に値が入り、サブフォームのテキストボックスと連動します。

フォーム・F_品目マスタのVBA

Ver.2.10

Option Compare Database
Option Explicit

'---------------------------------
Private Sub cmd_更新_Click()
On Error GoTo 終了
    Dim rst As DAO.Recordset
    Dim sql As String
    
    sql = "SELECT * FROM T_品目 WHERE '品目コード= " & Me.txt_品目コード & "'"
    Set rst = CurrentDb.OpenRecordset(sql)
    rst.FindFirst "品目コード= " & Me.txt_品目コード
        
        With rst
            .Edit
            .Fields("品目型式") = Me.txt_品目型式
            .Fields("メーカー") = Me.txt_メーカー
            .Fields("安全在庫") = Me.txt_安全在庫
            .Fields("最小ロット") = Me.txt_最小ロット
            .Fields("標準ロット") = Me.txt_標準ロット
            .Fields("標準納期") = Me.txt_標準納期
            .Fields("単価") = Me.txt_単価
            .Fields("仕入先コード") = Me.txt_仕入先コード
            .Fields("Webサイト") = Me.txt_Webサイト
            .Fields("削除") = Me.chk_削除
            .Update
            .Close
        End With
        Set rst = Nothing
        Me.SF_品目マスタ.Requery
    Exit Sub
終了:
    Call エラーログ("F_品目マスタ", "cmd_更新_Click")
End Sub

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call Form_Resize
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Call AdjustWidth(Me, Me.SF_品目マスタ, 0)
End Sub

'---------------------------------
Private Sub cmd_インポート_Click()
On Error GoTo 終了

    '---------------------------------
    'サブルーチンImportFromExcelはM_在庫管理にあります
    '---------------------------------
    ImportFromExcel ("品目")
    Me.SF_品目マスタ.Requery
    Exit Sub
終了:
    Call エラーログ("F_品目マスタ", "cmd_インポート_Click")
End Sub

'---------------------------------
Private Sub cmd_終了_Click()
    DoCmd.Close
End Sub

'---------------------------------
' マウスドラッグでフォーム移動
'---------------------------------
Private Sub フォームヘッダー_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

'---------------------------------
Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

社員マスタ

フォーム・F_社員マスタ

フォーム・F_社員マスタのVBAコード

サブフォームで「T_社員」を選択する以外は「品目マスタ」同様です。Ver.2.02

Option Compare Database
Option Explicit
Const pw = "password" '初期パスワードは「password」適宜書き換えてください

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call Form_Resize
    Me.SF_社員マスタ.Form.OrderBy = "社員コード"
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Call AdjustWidth(Me, Me.SF_社員マスタ, 0)
End Sub

'---------------------------------
Private Sub cmd_追加_Click()
On Error GoTo 終了

    Dim sql As String
    Dim rst As DAO.Recordset
    
    If IsNull([SF_社員マスタ].[Form]![社員コード]) Then
        Exit Sub
    Else
        If MsgBox("新規追加またはパスワードの初期化を行います。よろしいですか？", vbYesNo) = vbYes Then
            '---------------------------------
            '関数SHA256はM_SHA256にあります
            '---------------------------------
            
            sql = "SELECT * FROM T_社員 WHERE '社員コード= " & Me.txt_社員コード & "'"
            Set rst = CurrentDb.OpenRecordset(sql)
            rst.FindFirst "社員コード= " & Me.txt_社員コード
            
            With rst
                .AddNew
                .Fields("社員コード") = txt_社員コード
                .Fields("社員") = Nz(txt_社員, "")
                .Fields("所属") = Nz(txt_所属, "")
                .Fields("権限") = Nz(txt_権限, "")
                .Fields("パスワード") = SHA256(pw)
                .Fields("平文") = pw
                .Fields("初期パスワード") = True
                .Fields("登録日") = Date
                .Update
                .Close
                MsgBox "初期パスワード（「" & pw & "」）をご本人にお知らせください"
            End With
            Set rst = Nothing
            Me.SF_社員マスタ.Requery
        End If
    End If
    Exit Sub
終了:
    Debug.Print Err.Number
End Sub

'---------------------------------
Private Sub cmd_更新_Click()
On Error GoTo 終了
    Dim rst As DAO.Recordset
    Dim sql As String
    
    sql = "SELECT * FROM T_社員 WHERE '社員コード= " & Me.txt_社員コード & "'"
    Set rst = CurrentDb.OpenRecordset(sql)
    rst.FindFirst "社員コード= " & Me.txt_社員コード
        
        With rst
            .Edit
            .Fields("社員") = Nz(txt_社員, "")
            .Fields("所属") = Nz(txt_所属, "")
            .Fields("権限") = Nz(txt_権限, "")
            .Fields("削除") = Me.chk_削除
            If chk_初期化.Value = True Then
                .Fields("パスワード") = SHA256(pw)
                .Fields("初期パスワード") = True
            End If
            .Update
            .Close
        End With
        Set rst = Nothing
        Me.SF_社員マスタ.Requery
    Exit Sub
終了:
    Call エラーログ("F_社員マスタ", "cmd_更新_Click")
End Sub

'---------------------------------
Private Sub cmd_インポート_Click()

    '---------------------------------
    'サブルーチンImportFromExcelはM_在庫管理にあります
    '---------------------------------
    ImportFromExcel ("社員")
    Me.Requery
End Sub

'---------------------------------
Private Sub cmd_終了_Click()
    DoCmd.Close
End Sub

'---------------------------------
' マウスドラッグでフォーム移動
'---------------------------------
Private Sub フォームヘッダー_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

'---------------------------------
Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

仕入先マスタ

フォーム・F_仕入先マスタ

フォーム・F_仕入先マスタのVBAコード

サブフォームで「T_仕入先」を選択する以外は「品目マスタ」同様です。

Option Compare Database
Option Explicit

Private Sub cmd_更新_Click()
On Error GoTo 終了
    Dim rst As DAO.Recordset
    Dim sql As String
    
    sql = "SELECT * FROM T_仕入先 WHERE '仕入先コード= " & Me.txt_仕入先コード & "'"
    Set rst = CurrentDb.OpenRecordset(sql)
    rst.FindFirst "仕入先コード= " & Me.txt_仕入先コード
        
        With rst
            .Edit
            .Fields("仕入先コード") = txt_仕入先コード
            .Fields("仕入先会社名") = Nz(txt_会社名, "")
            .Fields("郵便番号") = Nz(txt_郵便番号, "")
            .Fields("住所") = Nz(txt_住所, "")
            .Fields("電話番号") = Nz(txt_電話番号, "")
            .Fields("FAX番号") = Nz(txt_FAX番号, "")
            .Fields("営業担当者") = Nz(txt_営業担当者, "")
            .Fields("携帯電話番号") = Nz(txt_携帯電話番号, "")
            .Fields("Eメールアドレス") = Nz(txt_Eメールアドレス, "")
            .Update
            .Close
        End With
        Set rst = Nothing
        Me.SF_仕入先マスタ.Form.OrderBy = "仕入先コード"
        Me.SF_仕入先マスタ.Requery
    Exit Sub
終了:
    Call エラーログ("F_仕入先マスタ", "cmd_更新_Click")
End Sub

Private Sub cmd_追加_Click()
On Error GoTo 終了

    Dim sql As String
    Dim rst As DAO.Recordset
    
    If IsNull([SF_仕入先マスタ].[Form]![仕入先コード]) Then
        Exit Sub
    Else
            
            sql = "SELECT * FROM T_仕入先 WHERE '仕入先コード= " & Me.txt_仕入先コード & "'"
            Set rst = CurrentDb.OpenRecordset(sql)
            rst.FindFirst "仕入先コード= " & Me.txt_仕入先コード
            
            With rst
                .AddNew
                .Fields("仕入先コード") = txt_仕入先コード
                .Fields("仕入先会社名") = Nz(txt_会社名, "")
                .Fields("郵便番号") = Nz(txt_郵便番号, "")
                .Fields("住所") = Nz(txt_住所, "")
                .Fields("電話番号") = Nz(txt_電話番号, "")
                .Fields("FAX番号") = Nz(txt_FAX番号, "")
                .Fields("営業担当者") = Nz(txt_営業担当者, "")
                .Fields("携帯電話番号") = Nz(txt_携帯電話番号, "")
                .Fields("Eメールアドレス") = Nz(txt_Eメールアドレス, "")
                .Update
                .Close
            End With
            Set rst = Nothing
            Me.SF_仕入先マスタ.Requery
    End If
    Exit Sub
終了:
    Debug.Print Err.Number
End Sub

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call Form_Resize
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Call AdjustWidth(Me, Me.SF_仕入先マスタ, 0)
End Sub

'---------------------------------
Private Sub cmd_インポート_Click()

    '---------------------------------
    'サブルーチンImportFromExcelはM_在庫管理にあります
    '---------------------------------
    ImportFromExcel ("仕入先")
    Me.SF_仕入先マスタ.Requery
End Sub

'---------------------------------
Private Sub cmd_終了_Click()
    DoCmd.Close
End Sub

'---------------------------------
' マウスドラッグでフォーム移動
'---------------------------------
Private Sub フォームヘッダー_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

'---------------------------------
Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

フォーム・F_各種設定（保管場所マスタ、入出庫マスタ、単位マスタ、指図番号マスタ）

Ver.2.10以降

F_各種設定を作った後、その他のテーブルもこれで暫定版になると思い、共通のフォームにしております。
合計5つのサブフォームをフォームフッターに配置し、全て「可視」プロパティを「いいえ」にしておきます。
メインからコマンドボタンをクリックしたときに、グローバル変数「strMaster」にてフォームを指定し、所定のフォームの可視（Visible）を「はい（true）」にします。
このフォームではstrMasterによって表示の処理を分けています。

 

F_各種設定のVBAコード

Ver.2.10

Option Compare Database
Option Explicit

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call Form_Resize
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Select Case strMaster
        Case "各種設定"
            Call AdjustWidth(Me, SF_各種設定, 0)
        Case "入出庫マスタ"
            Call AdjustWidth(Me, SF_入出庫, 0)
        Case "保管場所マスタ"
            Call AdjustWidth(Me, SF_保管場所, 0)
        Case "単位マスタ"
            Call AdjustWidth(Me, SF_単位, 0)
        Case "指図番号マスタ"
            Call AdjustWidth(Me, SF_指図番号, 0)
    End Select
    
End Sub

'---------------------------------
Private Sub cmd_close_Click()
    DoCmd.Close
End Sub

'---------------------------------
' マウスドラッグでフォーム移動
'---------------------------------
Private Sub フォームヘッダー_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

'---------------------------------
Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And acLeftButton Then
        ReleaseCapture
        Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

F_各種設定のVBAコード

Option Compare Database
Option Explicit

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Me.AllowEdits = False
End Sub

'---------------------------------
Private Sub Form_Close()
    Me.Visible = False
End Sub

-在庫管理