フォーム・F_在庫転送
空白のフォームから下記のようにコントロールを配置していきます。
- 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