在庫管理

在庫管理システム－入出庫処理

2022年10月15日

簡易マニュアル
ダウンロード
テーブル一覧
ログイン
　フォーム
　VBAコード
メインメニュー
　フォーム
　VBAコード
入出庫処理
　フォーム
　VBAコード
入出庫履歴
　フォーム
　クエリ
　VBAコード
在庫検索
　クエリ
　VBAコード
安全在庫
　フォーム
　クエリ
　VBAコード
在庫転送
　フォーム
　VBAコード
単位変換
　フォーム
　VBAコード
インポートとテーブルクリア
　フォーム
　VBAコード
マスタ
BOM構成
　フォーム
　VBAコード
エラーログ
その他
　ハッシュ値
　参照設定
　バーコード
　完成したら
　標準モジュールVBAコード

フォーム・F_入出庫処理

Access素人には苦労したフォームです。空白のフォームから下記のようにコントロールを配置していきます。

コンボボックスについてはもう少し記載しておきます。【プロパティシート】の【データ】タブの中の【値集合ソース】を下記のようにします。


cmb_品目

SELECT T_品目.品目コード,T_品目.品目型式 FROM T_品目 ORDER BY T_品目.品目型式;

cmb_入出庫

SELECT T_入出庫.入出庫コード,T_入出庫.入出庫 FROM T_入出庫;

cmb_単位

SELECT T_単位.単位コード , T_単位.単位 FROM T_単位;

cmb_保管場所

SELECT T_保管場所.保管場所コード,T_保管場所.保管場所 FROM T_保管場所;

コンボボックスは【プロパティシート】にて【列数】を「2」にします。そうすることによって、コンボボックスのプルダウンにて「コード」と「名前」が同時に表示できるようになります。選択される時は「コード」の方にしてあります。各列の幅が長かったり、短かったりすると思います。サンプルでは「列幅」に「1.5cm;5cm」を入力してあります。この数値を調整してください。コンボボックスの直下にラベルを配置したのは、コードだけでは不十分ですので、コードに対応する名前をラベルに表示させて、間違いを防止するようにします。

コンボボックス－列数２

VBAコード

フォーム・F_入出庫処理のVBAコード

フォーム「F_入出庫処理」のVBA（Ver.2.10）は下記の通りです。項目に空欄があると警告を出すようにしています。
「cmd_Cancel」ボタンを押すと、全てのコントロールを初期化してデータベースは更新しません。
データベースを更新したときにはAccessは何もアクションがないため、コントロールを初期化してメッセージボックスでデータベースを更新したことを報せます。
入出庫データは「T_入出庫処理」テーブルに格納されていきます。

Option Compare Database
Option Explicit

'---------------------------------
Private int入庫 As Integer
Private int入庫取消 As Integer
Private int出庫 As Integer
Private int出庫取消 As Integer
Private intBOM出庫 As Integer
Private intBOM出庫取消 As Integer
Private intBOM入庫 As Integer
Private intBOM入庫取消 As Integer
Private int入庫予約 As Integer
Private int入庫予約取消 As Integer
Private int出庫予約 As Integer
Private int出庫予約取消 As Integer


Private int個 As Integer

'---------------------------------
Private Sub Form_Load()
On Error GoTo 終了
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
    Call ClearControls
    Call Form_Resize
    
    '---------------------------------
    '関数ReadDatabaseはM_外部データベースにあります
    '---------------------------------
    int入庫 = Val(ReadDatabase("T_入出庫", "入出庫", "入庫", "入出庫コード"))
    int入庫取消 = Val(ReadDatabase("T_入出庫", "入出庫", "入庫取消", "入出庫コード"))
    int出庫 = Val(ReadDatabase("T_入出庫", "入出庫", "出庫", "入出庫コード"))
    int出庫取消 = Val(ReadDatabase("T_入出庫", "入出庫", "出庫取消", "入出庫コード"))
    intBOM出庫 = Val(ReadDatabase("T_入出庫", "入出庫", "BOM出庫", "入出庫コード"))
    intBOM出庫取消 = Val(ReadDatabase("T_入出庫", "入出庫", "BOM出庫取消", "入出庫コード"))
    intBOM入庫 = Val(ReadDatabase("T_入出庫", "入出庫", "BOM入庫", "入出庫コード"))
    intBOM入庫取消 = Val(ReadDatabase("T_入出庫", "入出庫", "BOM入庫取消", "入出庫コード"))
    
    int個 = Val(ReadDatabase("T_単位", "単位", "個", "単位コード"))
    
    chk_BOM.Value = False
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "Form_Load")
End Sub

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

'---------------------------------
Private Sub cmd_検索_Click()
On Error GoTo 終了
    Dim strFilter1 As String
    Dim strFilter2 As String

    With Me.SF_品目.Form
        If chk_BOM.Value = False Then
            strFilter1 = str検索フィルタ
            strFilter2 = "品目コード < " & lng子品目上限 + 1
            .Filter = strFilter1 & " And " & strFilter2
        Else
            .Filter = "品目コード > " & lng親品目下限 - 1
        End If
        .OrderBy = "品目コード"
        .FilterOn = True
    End With
    
    '---------------------------------
    'サブルーチン検索履歴はM_在庫管理にあります
    '---------------------------------
    If IsNull(cmb_品目型式) = False Then Call 検索履歴(Me.cmb_品目型式) 'コンボボックスの検索ワードをT_検索履歴に追加する
    Me.cmb_品目型式.Requery
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmd_検索_Click")
End Sub

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

'---------------------------------
Private Sub cmb_品目型式_Change()
    Call cmd_検索_Click
End Sub

'---------------------------------
Private Sub chk_BOM_AfterUpdate()
On Error GoTo 終了
    Call cmd_検索_Click
    If chk_BOM.Value = True Then
        cmb_単位.Value = 533
        cmb_単位_AfterUpdate
        cmb_入出庫.Value = intBOM出庫
        cmb_入出庫_AfterUpdate
    Else
        cmb_入出庫.Value = ""
        lbl_入出庫.Caption = ""
    End If
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "chk_BOM_AfterUpdate")
End Sub

'---------------------------------
' 入出庫処理本体
'---------------------------------
Private Sub cmd_OK_Click()
On Error GoTo 終了
    '空欄チェック
    Dim bBlank As Boolean
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim sql1, sql2, sql3 As String
    bBlank = False
    
    If chk_BOM.Value = False Then 'BOM出庫ではない場合
        If IsNull(Me.cmb_品目) Then cmb_品目.BackColor = vbYellow: bBlank = True Else cmb_品目.BackColor = vbWhite
        If Me.txt_数量 = "" Then txt_数量.BackColor = vbYellow: bBlank = True Else txt_数量.BackColor = vbWhite
        If IsNull(Me.cmb_単位) Then cmb_単位.BackColor = vbYellow: bBlank = True Else cmb_単位.BackColor = vbWhite
        If IsNull(Me.cmb_入出庫) Then cmb_入出庫.BackColor = vbYellow: bBlank = True Else cmb_入出庫.BackColor = vbWhite
        If IsNull(Me.cmb_保管場所) Then cmb_保管場所.BackColor = vbYellow: bBlank = True Else cmb_保管場所.BackColor = vbWhite
        If bBlank = True Then
            MsgBox ("空欄があります")
            Exit Sub
        End If
        Set rst = CurrentDb.OpenRecordset("T_入出庫処理")
        With rst
            .AddNew
            .Fields("日付") = Now
            .Fields("品目コード") = Me.cmb_品目
            .Fields("入出庫コード") = Me.cmb_入出庫
            .Fields("数量") = Me.txt_数量
            .Fields("単位コード") = Me.cmb_単位
            .Fields("保管場所コード") = Me.cmb_保管場所
            .Fields("社員コード") = lngLoginID
            .Fields("指図番号") = Me.cmb_指図番号
            .Fields("サイド番号") = Me.cmb_サイド番号
            .Update
            .Close
        End With
        Set rst = Nothing
    Else    'BOM出庫の場合
        If IsNull(Me.cmb_品目) Then cmb_品目.BackColor = vbYellow: bBlank = True Else cmb_品目.BackColor = vbWhite
        If Me.txt_数量 = "" Then txt_数量.BackColor = vbYellow: bBlank = True Else txt_数量.BackColor = vbWhite
        If bBlank = True Then
            MsgBox ("空欄があります")
            Exit Sub
        End If
        
        sql1 = "SELECT * FROM T_BOM "
        sql2 = "WHERE 親品目コード = " & cmb_品目.Value
        sql3 = "削除=False"
        Set rst2 = CurrentDb.OpenRecordset(sql1 & " AND " & sql2 & " AND " & sql3)
        Set rst = CurrentDb.OpenRecordset("T_入出庫処理")
        rst2.MoveFirst
        With rst
            Do While Not rst2.EOF
                '子品目を全部引っ張ってきて全部出庫する！
                .AddNew
                .Fields("日付") = Now
                .Fields("品目コード") = rst2.Fields("品目コード")
                .Fields("入出庫コード") = intBOM出庫
                .Fields("数量") = Val(rst2.Fields("数量") * txt_数量 * (-1))
                .Fields("単位コード") = rst2.Fields("単位コード")
                .Fields("保管場所コード") = rst2.Fields("保管場所コード")
                .Fields("社員コード") = lngLoginID
                .Fields("指図番号") = rst2.Fields("親品目コード") 'Me.cmb_指図番号
                .Update
                rst2.MoveNext
            Loop
            .AddNew     '親品目をBOM入庫
            .Fields("日付") = Now
            .Fields("品目コード") = cmb_品目
            .Fields("入出庫コード") = intBOM入庫
            .Fields("数量") = (txt_数量)
            .Fields("単位コード") = cmb_単位
            .Fields("保管場所コード") = cmb_保管場所
            .Fields("社員コード") = lngLoginID
            .Fields("指図番号") = cmb_指図番号
            .Fields("サイド番号") = cmb_サイド番号
            .Update
            .Close
        End With
        rst2.Close
        Set rst = Nothing
        Set rst2 = Nothing
    End If
    
    MsgBox ("記入しました")
    Call ClearControls
    Me.SF_品目.Form.FilterOn = True
    
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmd_OK_Click")
    Resume Next
End Sub

'---------------------------------
Private Sub cmd_cancel_Click()
    Call ClearControls
End Sub

'---------------------------------
Sub ClearControls()
    With Me
        .cmb_品目.Value = ""
        .lbl_品目.Caption = ""
        .txt_数量.Value = ""
        .cmb_単位.Value = int個
        .lbl_単位.Caption = "個"
        .cmb_入出庫.Value = ""
        .lbl_入出庫.Caption = ""
        .cmb_保管場所.Value = ""
        .lbl_保管場所.Caption = ""
        .cmb_指図番号.Value = ""
        .cmb_サイド番号.Value = ""
    End With
End Sub

'---------------------------------
Private Sub cmb_品目_AfterUpdate()
On Error GoTo 終了
    
    Me.lbl_品目.Caption = cmb_品目.Column(1)
    If IsNull(Me.cmb_品目) Then cmb_品目.BackColor = vbYellow Else cmb_品目.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmb_品目_AfterUpdate")
End Sub

'---------------------------------
Private Sub txt_数量_AfterUpdate()
On Error GoTo 終了
    If Me.txt_数量 = "" Then txt_数量.BackColor = vbYellow Else txt_数量.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "txt_数量_AfterUpdate")
End Sub

'---------------------------------
Private Sub cmb_単位_AfterUpdate()
On Error GoTo 終了
    
    Me.lbl_単位.Caption = cmb_単位.Column(1)
    If IsNull(Me.cmb_単位) Then cmb_単位.BackColor = vbYellow Else cmb_単位.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmb_単位_AfterUpdate")
End Sub

'---------------------------------
Private Sub cmb_入出庫_BeforeUpdate(Cancel As Integer)
On Error GoTo 終了
    If (Me.cmb_入出庫.Value = int出庫 Or _
        Me.cmb_入出庫.Value = int入庫取消 Or _
        Me.cmb_入出庫.Value = intBOM出庫 Or _
        Me.cmb_入出庫.Value = intBOM入庫取消) And Me.txt_数量.Value > 0 Then
        Me.txt_数量.Value = Me.txt_数量.Value * (-1)
    End If
    If (Me.cmb_入出庫.Value = int出庫取消 Or _
        Me.cmb_入出庫.Value = int入庫 Or _
        Me.cmb_入出庫.Value = intBOM入庫 Or _
        Me.cmb_入出庫.Value = intBOM出庫取消) And Me.txt_数量.Value < 0 Then
        Me.txt_数量.Value = Me.txt_数量.Value * (-1)
    End If
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmb_入出庫_BeforeUpdate")
End Sub

'---------------------------------
Private Sub cmb_入出庫_AfterUpdate()
On Error GoTo 終了
    
    Me.lbl_入出庫.Caption = cmb_入出庫.Column(1)
    If IsNull(Me.cmb_入出庫) Then cmb_入出庫.BackColor = vbYellow Else cmb_入出庫.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmb_入出庫_AfterUpdate")
End Sub

'---------------------------------
Private Sub cmb_保管場所_AfterUpdate()
On Error GoTo 終了
    
    Me.lbl_保管場所.Caption = cmb_保管場所.Column(1)
    If IsNull(Me.cmb_保管場所) Then cmb_保管場所.BackColor = vbYellow Else cmb_保管場所.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_入出庫処理", "cmb_保管場所_AfterUpdate")
End Sub

'---------------------------------
Private Sub cmd_入出庫履歴_Click()
On Error GoTo 終了
    DoCmd.OpenForm "F_入出庫履歴"
    DoCmd.Close acForm, "F_入出庫処理", acSaveNo
    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

入庫及び出庫取り消しのときにはプラスに、出庫及び入庫取り消しのときにはマイナスになるようにします。しかし、いかんせん、入出庫処理をせずに品目や商品を持っていったり入れたりする人がいるものです。棚卸しして差異が生じたときには「棚卸調整」にて増えたらプラスに減っていたらマイナスの数量を入力するようにします。

上記コードにて「600」が入庫、「601」は入庫取り消し。「610」は出庫、「611」は出庫取り消しとしております。これはサンプルデータベースの数値ですので、変更時には上記コードも修正ください。

独り言

ソースコードに数字を直接記載するのは良くないですね。
テーブルを参照して入庫や出庫を識別するようにした方が良いかと思います。

サブフォーム・SF_品目のVBAコード

表の中でダブルクリックしますと、その行の処理の削除を行えます。

Option Compare Database
Option Explicit

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

'---------------------------------
Private Sub 入出庫_DblClick(Cancel As Integer)
On Error GoTo 終了
    Dim rs As DAO.Recordset
    
    If Me!削除.Value = True Then Exit Sub
    
    If MsgBox("処理を取り消しますか？", vbYesNo, "処理取消") = vbYes Then
        Set rs = CurrentDb.OpenRecordset("T_入出庫処理")
        With rs
            .FindFirst "ID=" & Me!ID
            .Edit
            .Fields("削除") = True
            .Fields("削除日付") = Date
            .Update
        End With
        Set rs = Nothing
        MsgBox ("処理を取り消しました")
    End If
    Exit Sub
終了:
    Call エラーログ("SF_品目", "入出庫_DblClick")
End Sub

'---------------------------------
Private Sub 品目コード_DblClick(Cancel As Integer)
    '---------------------------------
    'サブルーチン処理はM_在庫管理にあります
    '---------------------------------
    Call 処理(Me.Form)
End Sub

'---------------------------------
Private Sub 品目型式_DblClick(Cancel As Integer)
    Call 処理(Me.Form)
End Sub

-在庫管理