在庫管理システム-BOM構成

メニュー（サイドバーが表示されない方向け）

概要

BOM（Bill Of Materials）は下図のようなイメージです。

: BOM構成（ツリー構造）

製品Aは仕掛Aと付属品・梱包材から構成され、その中にある仕掛AはユニットA・B、基板A・Bから構成され・・・という具合にツリー構造になっている品目をまとめて出庫しようというものです。

親品目コードを品目のテーブル「T_品目」に登録しておく必要があります（管理者のみ）。テーブル「T_各種設定」にて親品目コードの上限・下限と子品目コードの上限・下限を設定するようにしました。親品目コードの範囲に登録します。

フォーム・F_BOM

: BOM構成画面

親品目コードを選びます。フォーム上側のコンボボックスからプルダウンで選択します。
次に子品目コードをコンボボックスのプルダウンから選択するか、右の「品目検索」ボタンから品目検索フォームに飛び、品目をダブルクリックしますと子品目コードに反映されます。
親品目コードにぶら下げる数量・保管場所を入力のうえ、「子・追加」ボタンを押しますとBOMにぶら下げることができます。下側のサブフォームにも反映されます。

子品目を修正・削除する場合には、下側の子品目型式をダブルクリックしますと、その行の親品目コード・子品目コードが上側に反映されます。「子・削除」にて削除フラグが入り、数値や保管場所を編集のうえ「子・変更」を押しますと子品目が修正されます。

出庫処理

入出庫処理画面に「BOM」のチェックボックスを付けました。ここにチェックが入っていますと、下のサブフォームがBOM品目のみになります。
品目コード・品目型式の列でダブルクリックしますと、上部のコンボボックス「品目」に親品目が入ります。
親品目が構成される数量、それを保管する場所（ここまでは必須項目）、指図番号（予算の番号・必須項目ではない）を入力します。
実行ボタンを押しますと、親品目にぶら下がっている子品目が前述のBOM構成に従って在庫から引き落とされ、保管場所に親品目の在庫ができます。
引き落とされる子品目の数量は「作られる親品目の数量×親を構成するのに必要な子品目の数量」となります。
入出庫は「BOM出庫」から変更しないでください。
「BOM」のチェックを入れた時点で親品目の単位は自動的に「式」にしています。
出庫の結果、在庫数がマイナスになる場合にエラーとしておりません。

VBAコード

Ver.2.10

フォーム・F_BOMのVBAコード

F_BOM画面のVBAソースコード

Option Compare Database

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

'---------------------------------
Private Sub T_品目_1_品目型式_DblClick(Cancel As Integer)
On Error GoTo 終了
    '---------------------------------
    'サブルーチン処理はM_在庫管理にあります
    '---------------------------------
    lngBomID = Me!ID
    Call 処理(Me.Form)
    Parent.cmb_親品目コード_AfterUpdate
    Exit Sub
終了:
    Call エラーログ("SF_BOM", "T_品目_1_品目型式_DblClick")
End Sub

'---------------------------------
Private Sub 単位_DblClick(Cancel As Integer)
On Error GoTo 終了
    lngBomID = Me!ID
    Call 処理(Me.Form)
    Parent.cmb_親品目コード_AfterUpdate
    Exit Sub
終了:
    Call エラーログ("SF_BOM", "単位_DblClick")
End Sub

'---------------------------------
Private Sub 保管場所_DblClick(Cancel As Integer)
On Error GoTo 終了
    lngBomID = Me!ID
    Call 処理(Me.Form)
    Parent.cmb_親品目コード_AfterUpdate
    Exit Sub
終了:
    Call エラーログ("SF_BOM", "保管場所_DblClick")
End Sub

サブフォーム・SF_BOMのVBAコード

SF_BOMのVBAソースコード

Option Compare Database
Option Explicit

'---------------------------------
Private Sub Form_Load()
On Error GoTo 終了
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call Form_Resize
    lbl_親品目型式.Caption = ""
    lbl_子品目型式.Caption = ""
    lbl_保管場所.Caption = ""
    cmb_単位.Value = 529 '個
    lbl_単位.Caption = "個"
    Dim sql As String
    Dim strFilter As String

    Exit Sub
終了:
    Call エラーログ("F_BOM", "Form_Load")
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Call AdjustWidth(Me, Me.SF_BOM, 567)
End Sub


'---------------------------------
Private Sub cmd_子追加_Click()
On Error GoTo 終了
    'T_BOMになければ追加（数量チェック忘れずに）
    Dim sql As String
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim bBlank As Boolean
    bBlank = False
    
    If IsNull(cmb_親品目コード) Then cmb_親品目コード.BackColor = vbYellow: bBlank = True Else cmb_親品目コード.BackColor = vbWhite
    If IsNull(cmb_子品目コード) Then cmb_子品目コード.BackColor = vbYellow: bBlank = True Else cmb_子品目コード.BackColor = vbWhite
    If IsNull(txt_数量) Then txt_数量.BackColor = vbYellow: bBlank = True Else txt_数量.BackColor = vbWhite
    If Val(txt_数量.Value) = 0 Then txt_数量.BackColor = vbYellow: bBlank = True Else txt_数量.BackColor = vbWhite
    If IsNull(cmb_保管場所) Then cmb_保管場所.BackColor = vbYellow: bBlank = True Else cmb_保管場所.BackColor = vbWhite
    If IsNull(cmb_単位) Then cmb_単位.BackColor = vbYellow: bBlank = True Else cmb_単位.BackColor = vbWhite
    
    If bBlank = True Then
        MsgBox "空欄があります"
        Exit Sub
    End If
    
    'T_BOMになければ追加
    sql = "SELECT * FROM T_BOM WHERE 親品目コード=" & Me.cmb_親品目コード & " And 品目コード=" & Me.cmb_子品目コード
    Set rs1 = CurrentDb.OpenRecordset(sql)
    If rs1.EOF Then
        Set rs2 = CurrentDb.OpenRecordset("T_BOM")
        With rs2
            .AddNew
            .Fields("親品目コード") = cmb_親品目コード
            .Fields("品目コード") = cmb_子品目コード
            .Fields("数量") = txt_数量
            .Fields("単位コード") = cmb_単位
            .Fields("保管場所コード") = cmb_保管場所
            .Update
            .Close
        End With
    ElseIf rs1.Fields("削除") = True Then
        Set rs2 = CurrentDb.OpenRecordset("T_BOM")
        With rs2
            .AddNew
            .Fields("親品目コード") = cmb_親品目コード
            .Fields("品目コード") = cmb_子品目コード
            .Fields("数量") = txt_数量
            .Fields("単位コード") = cmb_単位
            .Fields("保管場所コード") = cmb_保管場所
            .Update
            .Close
        End With
    Else
        MsgBox "子品目コード：" & cmb_子品目コード.Value & lbl_子品目型式.Caption & vbCr & "は親品目：" & lbl_親品目型式.Caption & "のBOMに存在します"
    End If
    Me.SF_BOM.Requery
    
    Exit Sub
終了:
    Call エラーログ("F_BOM", "cmd_子追加_Click")
End Sub

'---------------------------------
Private Sub cmd_変更_Click()
On Error GoTo 終了
    Dim rst As DAO.Recordset
    
    Set rst = CurrentDb.OpenRecordset("T_BOM")
    With rst
        .FindFirst "ID=" & lngBomID
        .Edit
        .Fields("品目コード") = cmb_子品目コード.Value
        .Fields("数量") = txt_数量.Value
        .Fields("単位コード") = cmb_単位.Value
        .Fields("保管場所コード") = cmb_保管場所.Value
        .Fields("社員コード") = lngLoginID
        .Fields("変更日時") = Now
        .Update
    End With
    Set rst = Nothing
    SF_BOM.Requery
    Exit Sub
終了:
    Call エラーログ("F_BOM", "cmd_変更_Click")
End Sub

'---------------------------------
Private Sub cmd_子削除_Click()
On Error GoTo 終了
    'T_BOMに削除フラグ
    Dim rst As DAO.Recordset
    
    If MsgBox("削除してもよろしいですか？", vbYesNo) = vbYes Then
        Set rst = CurrentDb.OpenRecordset("T_BOM")
        With rst
            .FindFirst "ID=" & lngBomID
            .Edit
            .Fields("削除") = True
            .Fields("社員コード") = lngLoginID
            .Fields("削除日時") = Now
            .Update
        End With
        Set rst = Nothing
        'Requery
        SF_BOM.Requery
    End If
    Exit Sub
終了:
    Call エラーログ("F_BOM", "cmd_子削除_Click")
End Sub

'---------------------------------
Public Sub cmb_親品目コード_AfterUpdate()
On Error GoTo 終了
    Dim sql As String
    
    Me.lbl_親品目型式.Caption = cmb_親品目コード.Column(1)
    
    sql = "親品目コード = " & cmb_親品目コード.Value
    With Me.SF_BOM.Form
        .Filter = sql
        .FilterOn = True
    End With
    Exit Sub
終了:
    Call エラーログ("F_BOM", "cmb_親品目コード_AfterUpdate")
End Sub

'---------------------------------
Private Sub cmb_子品目コード_AfterUpdate()
    Me.lbl_子品目型式.Caption = cmb_子品目コード.Column(1)
End Sub

'---------------------------------
Private Sub cmb_単位_AfterUpdate()
    Me.lbl_単位.Caption = cmb_単位.Column(1)
End Sub

'---------------------------------
Private Sub cmb_保管場所_AfterUpdate()
    Me.lbl_保管場所.Caption = cmb_保管場所.Column(1)
End Sub

'---------------------------------
Private Sub cmd_検索_Click()
    DoCmd.OpenForm "F_在庫検索"
End Sub

'---------------------------------
Private Sub cmd_インポート_Click()
    '---------------------------------
    'サブルーチンImportFromExcelはM_在庫管理にあります
    '---------------------------------
    ImportFromExcel ("BOM")
    Me.SF_BOM.Requery
End Sub

'---------------------------------
Private Sub cmd_エクスポート_Click()
On Error GoTo 終了
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Q_BOM", "在庫管理.xls", True, "BOM"
    MsgBox ("マイドキュメントにエクスポートしました")
    Exit Sub
終了:
    Call エラーログ("F_BOM", "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