広告 在庫管理

在庫管理システム-メイン

2022年10月15日

Ver.2.00βでは「cmd_各種設定」ボタンを押しても何も起こりません。
現時点ではテーブル「各種設定」の内容を変更する場合にはT_各種設定を直接編集します。

フォーム・F_メイン

【作成】からフォームの中の【空白のフォーム】を選んで、コマンドボタンを貼っていきます。1つコマンドボタンを作ったらコピペで増やしていくと、同じサイズのボタンになります。ヘッダーとフッターも使用しました。

メインメニューの下半分、管理者メニューとし、管理者でログインした以外はグレーアウトするようにしてあります。

VBAコード

  • コマンドボタンのプロパティのイベントが空のままです。イベントを割り当てなければなりませんので、【プロパティシート】の【イベント】タブの【…】をクリックします。
  • 【コードビルダー】を選んで【OK】をクリックします。上述のVBAのコードに飛びます。コマンドボタン1つ1つにこの作業が必要です。

メインフォームのVBAは下記の通りです。(Ver.2.01βのコードです)

Option Compare Database
Option Explicit

'---------------------------------
Private Sub Form_Load()
    Dim txtVer As String
    Dim txtβ As String
    
    '---------------------------------
    '関数GetWindowSizeはM_画面にあります
    '関数GetDatabaeLastはM_在庫管理にあります
    '---------------------------------
    lngDisplayRes = GetWindowSize   '画面の解像度を取得する
    txtVer = Format(GetDatabaeLast("T_バージョン履歴", "バージョン"), "0.00")
    txtβ = GetDatabaeLast("T_バージョン履歴", "β")
    lbl_Title.Caption = lbl_Title.Caption & " Ver." & txtVer & txtβ
    
    If bAdmin = False Then          '管理者(Admin)でなければ管理者メニューをDisableに
        cmd_品目マスタ.Enabled = False
        cmd_社員マスタ.Enabled = False
        cmd_仕入先マスタ.Enabled = False
        cmd_ログイン履歴.Enabled = False
        cmd_各種設定.Enabled = False
        cmd_インポート.Enabled = False
        cmd_TableClear.Enabled = False
        cmd_インポート.Enabled = False
        cmd_TableClear.Enabled = False
        'cmd_デバッグ.Enabled = False'リボンを消す際は行頭のコメントを消去
    End If
    'cmd_デバッグ.Visible = False    'リボンを消す際は行頭のコメントを消去
End Sub

'---------------------------------
Private Sub cmd_PW変更_Click()
    DoCmd.OpenForm "F_PW変更"
    
    Forms![F_PW変更]![txt_社員コード].Value = lngLoginID
    Forms![F_PW変更]![txt_社員コード].SetFocus
End Sub

'---------------------------------
Private Sub cmd_インポート_Click()
    If MsgBox("旧バージョンのデータベースファイルを選択してください。" & vbCr _
        & "現在のテーブルを消去してインポートします。" & vbCr _
        & "必ずバックアップを取って実行してください。" & vbCr _
        & "よろしければYesをクリックしてください", vbYesNo) = vbYes Then
        
        '---------------------------------
        'サブルーチンImportはM_外部データベースにあります
        '---------------------------------
        Call Import
    End If
End Sub

'---------------------------------
Private Sub cmd_入出庫処理_Click()
    DoCmd.OpenForm "F_入出庫処理"
End Sub

'---------------------------------
Private Sub cmd_入出庫履歴_Click()
    DoCmd.OpenForm "F_入出庫履歴"
End Sub

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

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

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

'---------------------------------
Private Sub cmd_単位変換_Click()
    DoCmd.OpenForm "F_単位変換"
End Sub

'---------------------------------
Private Sub cmd_品目マスタ_Click()
    DoCmd.OpenForm "F_品目マスタ"
End Sub

'---------------------------------
Private Sub cmd_社員マスタ_Click()
    DoCmd.OpenForm "F_社員マスタ"
End Sub

'---------------------------------
Private Sub cmd_仕入先マスタ_Click()
    DoCmd.OpenForm "F_仕入先マスタ"
End Sub

'---------------------------------
Private Sub cmd_ログイン履歴_Click()
    DoCmd.OpenForm "F_ログイン履歴"
End Sub

'---------------------------------
Private Sub cmd_TableClear_Click()
    DoCmd.OpenForm "F_テーブルクリア"
End Sub

'---------------------------------
Private Sub cmd_デバッグ_Click()
    'リボンを表示
    DoCmd.ShowToolbar "Ribbon", acToolbarYes
End Sub

'---------------------------------
'閉じる時にログアウト日時を記録
'---------------------------------
Private Sub cmd_閉じる_Click()
On Error Resume Next                    'ログインなしに開いた場合にエラーになるため
    Dim dbs As Database
    Dim rst As DAO.Recordset
    Dim sql As String
    
    Set dbs = CurrentDb
    Set rst = CurrentDb.OpenRecordset("T_ログイン履歴", dbOpenDynaset)
    With rst
        .MoveLast                       '一旦最後に移動しないと機能しない
        .AbsolutePosition = intID - 1   'ID=intIDの行に移動
        .Edit
        .Fields("ログアウト日時") = Now
        .Update
        .Close
    End With
    Set rst = Nothing
    
    DoCmd.Close
End Sub

-在庫管理