在庫管理システム－単位変換

フォーム・F_単位変換

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

品目：コンボボックス（名前：cmb_品目）、直下にラベル配置（名前：lbl_品目）
変換前数量：テキストボックス（名前：txt_変換前数量）
変換後数量：テキストボックス（名前：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_単位;

cmb_保管場所

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

VBAコード

Ver.2.10

フォーム・F_単位変換のVBAコード

単位変換は購買からの発注が「1式」「1箱」などを1式は「100個」とか1箱は「12個」などにする場合です。最初から1式で入荷しても在庫管理システムでは100個と入力する場合には不要な処理です。
将来的に購買への発注伝票作成や購買が入力処理することも念頭に置いての処理です。ただし購買関連の機能は実装しておりません。

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モードオフ
    txt_変換後数量.IMEMode = acImeModeDisable   'IMEモードオフ

    Exit Sub
終了:
    Call エラーログ("F_単位変換", "Form_Load")
End Sub

'---------------------------------
Private Sub Form_Resize()
    '---------------------------------
    'サブルーチンAdjustWidthはM_画面にあります
    '---------------------------------
    Call AdjustWidth(Me, Me.SF_単位変換, 0)
End Sub

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

    strFilter1 = str検索フィルタ
    strFilter2 = "品目コード < " & lng子品目上限 + 1

    With Me.SF_単位変換.Form
        .Filter = strFilter1 & " And " & strFilter2
        .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 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 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_変換前数量
        .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 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 txt_変換前数量_AfterUpdate()
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_変換前数量_AfterUpdate")
End Sub

'---------------------------------
Private Sub txt_変換後数量_AfterUpdate()
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_変換後数量_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 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_cancel_Click()
    Call ClearControls
End Sub

'---------------------------------
Sub ClearControls()
    With Me
        .cmb_品目.Value = ""
        .lbl_品目.Caption = ""
        .cmb_変換前単位.Value = ""
        .lbl_変換前単位.Caption = ""
        .cmb_変換後単位.Value = ""
        .lbl_変換後単位.Caption = ""
        .txt_変換前数量.Value = ""
        .txt_変換後数量.Value = ""
        .cmb_保管場所.Value = ""
        .lbl_保管場所.Caption = ""
    End With
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

サブフォーム・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