在庫管理システム－在庫転送

フォーム・F_在庫転送

空白のフォームから下記のようにコントロールを配置していきます。

コントロールは「F_入出庫処理」とほぼ同様です。どちらかのフォームを先に作成し、複製して改造方が早いです。

品目：コンボボックス（名前：cmb_品目）、直下にラベル配置（名前：lbl_品目）
数量：テキストボックス（名前：txt_数量）
単位：コンボボックス（名前：cmb_単位）、直下にラベル配置（名前：lbl_単位）
転送元：コンボボックス（名前：cmb_転送元）、直下にラベル配置（名前：lbl_転送元）
転送先：コンボボックス（名前：cmb_転送先）、直下にラベル配置（名前：lbl_転送先）

コンボボックスのプロパティシートのデータタブの中の値集合ソースを下記のようにします。
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_保管場所;

VBAコード

Ver.2.10

フォーム・F_在庫転送のVBAコード

Option Compare Database
Option Explicit

'---------------------------------
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
    
    int在庫転入 = Val(ReadDatabase("T_入出庫", "入出庫", "在庫転入", "入出庫コード"))
    int在庫転入取消 = Val(ReadDatabase("T_入出庫", "入出庫", "在庫転入取消", "入出庫コード"))
    int在庫転出 = Val(ReadDatabase("T_入出庫", "入出庫", "在庫転出", "入出庫コード"))
    int在庫転出取消 = Val(ReadDatabase("T_入出庫", "入出庫", "在庫転出取消", "入出庫コード"))
    int個 = Val(ReadDatabase("T_単位", "単位", "個", "単位コード"))
    txt_数量.IMEMode = acImeModeDisable   'IMEモードオフ
    
    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
    
    '---------------------------------
    'サブルーチン検索履歴はM_在庫管理にあります
    '---------------------------------
    If IsNull(cmb_品目型式) = False Then Call 検索履歴(Me.cmb_品目型式) 'コンボボックスの検索ワードをT_検索履歴に追加する
    Me.cmb_品目型式.Requery
    Exit Sub
終了:
    Call エラーログ("F_在庫転送", "cmd_検索_Click")
End Sub

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

'---------------------------------
Private Sub cmd_入出庫履歴_Click()
    DoCmd.OpenForm "F_入出庫履歴"
    DoCmd.Close acForm, "F_在庫転送", acSaveNo
End Sub

'---------------------------------
Private Sub cmd_OK_Click()
On Error GoTo 終了
    '空欄チェック
    Dim bBlank As Boolean
    bBlank = False
    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
    If Me.cmb_転送元.Value = Me.cmb_転送先.Value Then
        MsgBox ("転送元と転送先が同じです")
        Exit Sub
    End If
    
    
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("T_入出庫処理")
    With rst
        .AddNew
        .Fields("日付") = Now
        .Fields("品目コード") = Me.cmb_品目
        .Fields("入出庫コード") = int在庫転出
        .Fields("数量") = Me.txt_数量 * (-1)
        .Fields("保管場所コード") = Me.cmb_転送元
        .Fields("単位コード") = Me.cmb_単位
        .Fields("社員コード") = lngLoginID
        .Update
        .AddNew
        .Fields("日付") = Now
        .Fields("品目コード") = Me.cmb_品目
        .Fields("入出庫コード") = int在庫転入
        .Fields("数量") = Me.txt_数量
        .Fields("保管場所コード") = Me.cmb_転送先
        .Fields("単位コード") = Me.cmb_単位
        .Fields("社員コード") = lngLoginID
        .Update
    End With
    
    rst.Close
    Set rst = Nothing
    
    MsgBox ("記入しました")
    Call ClearControls
    Exit Sub
終了:
    Call エラーログ("F_在庫転送", "cmd_OK_Click")
End Sub

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

'---------------------------------
Private Sub cmb_品目_AfterUpdate()
On Error GoTo 終了
    
    Me.lbl_品目.Caption = Me.cmb_品目.Column(1)
    If IsNull(Me.cmb_品目) Then Me.cmb_品目.BackColor = vbYellow Else Me.cmb_品目.BackColor = vbWhite
    [cmb_品目型式].Value = Me.cmb_品目.Column(1)
    cmd_検索_Click
    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 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_数量_BeforeUpdate(Cancel As Integer)
On Error GoTo 終了
    If txt_数量.Value < 0 Then txt_数量.Value = txt_数量.Value * (-1)
    If Me.txt_数量 = "" Then txt_数量.BackColor = vbYellow Else txt_数量.BackColor = vbWhite
    Exit Sub
終了:
    Call エラーログ("F_在庫転送", "txt_数量_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 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

'---------------------------------
Sub ClearControls()
    With Me
        .cmb_品目.Value = ""
        .lbl_品目.Caption = ""
        .cmb_転送元.Value = ""
        .lbl_転送元.Caption = ""
        .cmb_転送先.Value = ""
        .lbl_転送先.Caption = ""
        .txt_数量.Value = ""
        .cmb_単位.Value = int個
        .lbl_単位.Caption = "個"
    End With
End Sub

サブフォーム・SF_在庫転送のVBAコード

表の中の品目コード・品目型式・保管場所の列にてダブルクリックしますと、その行の内容が上半分のテキストボックスやコンボボックスに反映されます。

Option Compare Database
Option Explicit

'---------------------------------
Private Sub Form_Load()
    '---------------------------------
    'サブルーチンFormInitはM_画面にあります
    '---------------------------------
    Call FormInit(Me.Form)
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

'---------------------------------
Private Sub 保管場所_DblClick(Cancel As Integer)
    Call 処理(Me.Form)
End Sub