品目マスタ
フォーム・F_品目マスタ
品目の基本情報(マスタ)を編集したいときがきます。そのためのフォームを作ります。
上半分にテキストボックスを、下半分にサブフォーム(テーブル品目を選択)を配置していきます。
フォームの【レコードソース】にテーブルを割り当てるのではなく、テキストボックスをサブフォームのテキストボックスに合わせていきます。
サブフォームの項目の分だけ上半分にテキストボックスとチェックボックスを配置します。
- 品目マスタ画面
テキストボックスとサブフォームのテキストボックスの関連付け
上半分のテキストボックスの【プロパティ】の【データ】にて、【コントロールソース】の右端の【…】をクリックします。
(下図はコンボボックスになっておりますが、テキストボックスも同様です。)
- プロパティ】にて【…】をクリックします。
下記のように、サブフォーム-フィールド-<値>とし、<値>のところでダブルクリックします。
テキストボックスには
=[品目のサブフォーム].[Form]![品目コード]
という具合に値が入り、サブフォームのテキストボックスと連動します。
- 【式の値】で<値>をダブルクリックする
フォーム・F_品目マスタのVBA
Ver.2.10
Option Compare Database
Option Explicit
'---------------------------------
Private Sub cmd_更新_Click()
On Error GoTo 終了
Dim rst As DAO.Recordset
Dim sql As String
sql = "SELECT * FROM T_品目 WHERE '品目コード= " & Me.txt_品目コード & "'"
Set rst = CurrentDb.OpenRecordset(sql)
rst.FindFirst "品目コード= " & Me.txt_品目コード
With rst
.Edit
.Fields("品目型式") = Me.txt_品目型式
.Fields("メーカー") = Me.txt_メーカー
.Fields("安全在庫") = Me.txt_安全在庫
.Fields("最小ロット") = Me.txt_最小ロット
.Fields("標準ロット") = Me.txt_標準ロット
.Fields("標準納期") = Me.txt_標準納期
.Fields("単価") = Me.txt_単価
.Fields("仕入先コード") = Me.txt_仕入先コード
.Fields("Webサイト") = Me.txt_Webサイト
.Fields("削除") = Me.chk_削除
.Update
.Close
End With
Set rst = Nothing
Me.SF_品目マスタ.Requery
Exit Sub
終了:
Call エラーログ("F_品目マスタ", "cmd_更新_Click")
End Sub
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
Call Form_Resize
End Sub
'---------------------------------
Private Sub Form_Resize()
'---------------------------------
'サブルーチンAdjustWidthはM_画面にあります
'---------------------------------
Call AdjustWidth(Me, Me.SF_品目マスタ, 0)
End Sub
'---------------------------------
Private Sub cmd_インポート_Click()
On Error GoTo 終了
'---------------------------------
'サブルーチンImportFromExcelはM_在庫管理にあります
'---------------------------------
ImportFromExcel ("品目")
Me.SF_品目マスタ.Requery
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
社員マスタ
フォーム・F_社員マスタ
フォーム・F_社員マスタのVBAコード
サブフォームで「T_社員」を選択する以外は「品目マスタ」同様です。Ver.2.02
Option Compare Database
Option Explicit
Const pw = "password" '初期パスワードは「password」適宜書き換えてください
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
Call Form_Resize
Me.SF_社員マスタ.Form.OrderBy = "社員コード"
End Sub
'---------------------------------
Private Sub Form_Resize()
'---------------------------------
'サブルーチンAdjustWidthはM_画面にあります
'---------------------------------
Call AdjustWidth(Me, Me.SF_社員マスタ, 0)
End Sub
'---------------------------------
Private Sub cmd_追加_Click()
On Error GoTo 終了
Dim sql As String
Dim rst As DAO.Recordset
If IsNull([SF_社員マスタ].[Form]![社員コード]) Then
Exit Sub
Else
If MsgBox("新規追加またはパスワードの初期化を行います。よろしいですか?", vbYesNo) = vbYes Then
'---------------------------------
'関数SHA256はM_SHA256にあります
'---------------------------------
sql = "SELECT * FROM T_社員 WHERE '社員コード= " & Me.txt_社員コード & "'"
Set rst = CurrentDb.OpenRecordset(sql)
rst.FindFirst "社員コード= " & Me.txt_社員コード
With rst
.AddNew
.Fields("社員コード") = txt_社員コード
.Fields("社員") = Nz(txt_社員, "")
.Fields("所属") = Nz(txt_所属, "")
.Fields("権限") = Nz(txt_権限, "")
.Fields("パスワード") = SHA256(pw)
.Fields("平文") = pw
.Fields("初期パスワード") = True
.Fields("登録日") = Date
.Update
.Close
MsgBox "初期パスワード(「" & pw & "」)をご本人にお知らせください"
End With
Set rst = Nothing
Me.SF_社員マスタ.Requery
End If
End If
Exit Sub
終了:
Debug.Print Err.Number
End Sub
'---------------------------------
Private Sub cmd_更新_Click()
On Error GoTo 終了
Dim rst As DAO.Recordset
Dim sql As String
sql = "SELECT * FROM T_社員 WHERE '社員コード= " & Me.txt_社員コード & "'"
Set rst = CurrentDb.OpenRecordset(sql)
rst.FindFirst "社員コード= " & Me.txt_社員コード
With rst
.Edit
.Fields("社員") = Nz(txt_社員, "")
.Fields("所属") = Nz(txt_所属, "")
.Fields("権限") = Nz(txt_権限, "")
.Fields("削除") = Me.chk_削除
If chk_初期化.Value = True Then
.Fields("パスワード") = SHA256(pw)
.Fields("初期パスワード") = True
End If
.Update
.Close
End With
Set rst = Nothing
Me.SF_社員マスタ.Requery
Exit Sub
終了:
Call エラーログ("F_社員マスタ", "cmd_更新_Click")
End Sub
'---------------------------------
Private Sub cmd_インポート_Click()
'---------------------------------
'サブルーチンImportFromExcelはM_在庫管理にあります
'---------------------------------
ImportFromExcel ("社員")
Me.Requery
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
仕入先マスタ
フォーム・F_仕入先マスタ
フォーム・F_仕入先マスタのVBAコード
サブフォームで「T_仕入先」を選択する以外は「品目マスタ」同様です。
Option Compare Database
Option Explicit
Private Sub cmd_更新_Click()
On Error GoTo 終了
Dim rst As DAO.Recordset
Dim sql As String
sql = "SELECT * FROM T_仕入先 WHERE '仕入先コード= " & Me.txt_仕入先コード & "'"
Set rst = CurrentDb.OpenRecordset(sql)
rst.FindFirst "仕入先コード= " & Me.txt_仕入先コード
With rst
.Edit
.Fields("仕入先コード") = txt_仕入先コード
.Fields("仕入先会社名") = Nz(txt_会社名, "")
.Fields("郵便番号") = Nz(txt_郵便番号, "")
.Fields("住所") = Nz(txt_住所, "")
.Fields("電話番号") = Nz(txt_電話番号, "")
.Fields("FAX番号") = Nz(txt_FAX番号, "")
.Fields("営業担当者") = Nz(txt_営業担当者, "")
.Fields("携帯電話番号") = Nz(txt_携帯電話番号, "")
.Fields("Eメールアドレス") = Nz(txt_Eメールアドレス, "")
.Update
.Close
End With
Set rst = Nothing
Me.SF_仕入先マスタ.Form.OrderBy = "仕入先コード"
Me.SF_仕入先マスタ.Requery
Exit Sub
終了:
Call エラーログ("F_仕入先マスタ", "cmd_更新_Click")
End Sub
Private Sub cmd_追加_Click()
On Error GoTo 終了
Dim sql As String
Dim rst As DAO.Recordset
If IsNull([SF_仕入先マスタ].[Form]![仕入先コード]) Then
Exit Sub
Else
sql = "SELECT * FROM T_仕入先 WHERE '仕入先コード= " & Me.txt_仕入先コード & "'"
Set rst = CurrentDb.OpenRecordset(sql)
rst.FindFirst "仕入先コード= " & Me.txt_仕入先コード
With rst
.AddNew
.Fields("仕入先コード") = txt_仕入先コード
.Fields("仕入先会社名") = Nz(txt_会社名, "")
.Fields("郵便番号") = Nz(txt_郵便番号, "")
.Fields("住所") = Nz(txt_住所, "")
.Fields("電話番号") = Nz(txt_電話番号, "")
.Fields("FAX番号") = Nz(txt_FAX番号, "")
.Fields("営業担当者") = Nz(txt_営業担当者, "")
.Fields("携帯電話番号") = Nz(txt_携帯電話番号, "")
.Fields("Eメールアドレス") = Nz(txt_Eメールアドレス, "")
.Update
.Close
End With
Set rst = Nothing
Me.SF_仕入先マスタ.Requery
End If
Exit Sub
終了:
Debug.Print Err.Number
End Sub
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
Call Form_Resize
End Sub
'---------------------------------
Private Sub Form_Resize()
'---------------------------------
'サブルーチンAdjustWidthはM_画面にあります
'---------------------------------
Call AdjustWidth(Me, Me.SF_仕入先マスタ, 0)
End Sub
'---------------------------------
Private Sub cmd_インポート_Click()
'---------------------------------
'サブルーチンImportFromExcelはM_在庫管理にあります
'---------------------------------
ImportFromExcel ("仕入先")
Me.SF_仕入先マスタ.Requery
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
フォーム・F_各種設定(保管場所マスタ、入出庫マスタ、単位マスタ、指図番号マスタ)
Ver.2.10以降
F_各種設定を作った後、その他のテーブルもこれで暫定版になると思い、共通のフォームにしております。
合計5つのサブフォームをフォームフッターに配置し、全て「可視」プロパティを「いいえ」にしておきます。
メインからコマンドボタンをクリックしたときに、グローバル変数「strMaster」にてフォームを指定し、所定のフォームの可視(Visible)を「はい(true)」にします。
このフォームではstrMasterによって表示の処理を分けています。
F_各種設定のVBAコード
Ver.2.10
Option Compare Database
Option Explicit
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
Call Form_Resize
End Sub
'---------------------------------
Private Sub Form_Resize()
'---------------------------------
'サブルーチンAdjustWidthはM_画面にあります
'---------------------------------
Select Case strMaster
Case "各種設定"
Call AdjustWidth(Me, SF_各種設定, 0)
Case "入出庫マスタ"
Call AdjustWidth(Me, SF_入出庫, 0)
Case "保管場所マスタ"
Call AdjustWidth(Me, SF_保管場所, 0)
Case "単位マスタ"
Call AdjustWidth(Me, SF_単位, 0)
Case "指図番号マスタ"
Call AdjustWidth(Me, SF_指図番号, 0)
End Select
End Sub
'---------------------------------
Private Sub cmd_close_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
F_各種設定のVBAコード
Option Compare Database
Option Explicit
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
Me.AllowEdits = False
End Sub
'---------------------------------
Private Sub Form_Close()
Me.Visible = False
End Sub