概要
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コード
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コード
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