Ver.2.00βでは「cmd_各種設定」ボタンを押しても何も起こりません。
現時点ではテーブル「各種設定」の内容を変更する場合にはT_各種設定を直接編集します。
フォーム・F_メイン
【作成】からフォームの中の【空白のフォーム】を選んで、コマンドボタンを貼っていきます。1つコマンドボタンを作ったらコピペで増やしていくと、同じサイズのボタンになります。ヘッダーとフッターも使用しました。
メインメニューの下半分、管理者メニューとし、管理者でログインした以外はグレーアウトするようにしてあります。
- フォームの作成
- メインフォーム
VBAコード
- コマンドボタンのプロパティのイベントが空のままです。イベントを割り当てなければなりませんので、【プロパティシート】の【イベント】タブの【…】をクリックします。
- 【コードビルダー】を選んで【OK】をクリックします。上述のVBAのコードに飛びます。コマンドボタン1つ1つにこの作業が必要です。
- プロパティ】にて【…】をクリックします。
- 【コードビルダー】を選んで【OK】をクリック
メインフォームの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