共通の
メニューバー 作成のプロシージャです。
マクロ
AutoExec で起動時に作成(更新)します。
個々のデータベースのメニューバーは、この後ろに追加するようにします。
このプロシージャを実行すると下のようになります。

各プロパティの意味は
- OnAction → 実行させるプロシージャ名
- Caption → 表示名
- BeginGroup → 仕切り線
- FaceId = 59 → フェイスボタン
- 追加メニューバー数は必要に応じて指定します。(三つまで)
Option Compare Database
Option Explicit
Public Const myMenuID As Integer = 15 '追加メニューバー1 IDNo
Const myMenuNo As Integer = 1 '追加メニューバー数
Dim myButton1 As String
Dim myCaption(10) As String
Dim myAction(10) As String
Function PFMenuBar01Set01()
''設定 Caption OnAction メニューバー1 常用 2003/4/20
' PFMenuBar01Set01
myButton1 = "常 用"
myCaption(0) = "VBA Test"
myCaption(1) = ""
myCaption(2) = "Module Export"
myCaption(3) = "Module Import"
myCaption(4) = "Module Remove"
myCaption(5) = "Module ImportMaster"
myCaption(6) = "更新 MenuBar"
myCaption(7) = "追加 MenuBar2"
myCaption(8) = "削除 MenuBar2"
myCaption(9) = "BackUp Object"
myAction(0) = "FVBATest01"
myAction(1) = ""
myAction(2) = "FMoExportCom00"
myAction(3) = "PMoImportCom00"
myAction(4) = "PMoRemove00"
myAction(5) = "PMoImportMaster"
myAction(6) = "UpdateMenuBarALL"
myAction(7) = "FMenuBar02"
myAction(8) = "PFAddMenuBarDel"
myAction(9) = "SBackupObjectNoProgressALL01"
End Function
Sub UpdateMenuBarALL()
''更新 全てのMenuBar
' UpdateMenuBarALL
''作成 メニューバー1 常用 2003/4/19
PFMenuBar01
If myMenuNo = 2 Then
''更新・作成 メニューバー2 Button2 2003/4/20
FMenuBar02
ElseIf myMenuNo = 3 Then
''更新・作成 メニューバー3 Button3 2003/4/20
FMenuBar03
End If
End Sub
Function PFMenuBar01()
''作成 メニューバー1 常用 2003/4/19
' PFMenuBar01
Dim MyCB01 As CommandBarControl
Dim MyCB02 As CommandBarControl
Dim myBname As String
Dim myButtonImage1 As Integer
myButtonImage1 = 59 '""
''設定 Caption OnAction メニューバー1 常用 2003/4/20
PFMenuBar01Set01
''リセット Menu Bar
ResetMenuBar
''メニューバー名
myBname = CommandBars.ActiveMenuBar.name 'myBname : "Menu Bar"
'MsgBox myBname & " " & myButton1
'----------------------------------------------------------------
''1つ目のボタンの作成 (Popup) 常用
Set MyCB01 = CommandBars(myBname).Controls.Add(msoControlPopup, , , myMenuID, True)
With MyCB01
.BeginGroup = True
.Caption = myButton1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=1)
With MyCB02
.Caption = myCaption(0)
.OnAction = myAction(0)
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=2)
With MyCB02
.Caption = myCaption(1)
.OnAction = myAction(1)
' .FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=3)
With MyCB02
.Caption = myCaption(2)
.OnAction = myAction(2)
.FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=4)
With MyCB02
.Caption = myCaption(3)
.OnAction = myAction(3)
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=5)
With MyCB02
.Caption = myCaption(4)
.OnAction = myAction(4)
' .FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=6)
With MyCB02
.Caption = myCaption(5)
.OnAction = myAction(5)
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=7)
With MyCB02
.Caption = myCaption(6)
.OnAction = myAction(6)
.FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=8)
With MyCB02
.Caption = myCaption(7)
.OnAction = myAction(7)
' .FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=9)
With MyCB02
.Caption = myCaption(8)
.OnAction = myAction(8)
' .FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=10)
With MyCB02
.Caption = myCaption(9)
.OnAction = myAction(9)
.FaceId = myButtonImage1
End With
End Function
Sub ResetMenuBar()
''リセット Menu Bar
' ResetMenuBar
CommandBars("Menu Bar").Reset
End Sub
Sub UpdateMenuBar01()
''更新 PFMenuBar01
''作成 メニューバー1 常用 2003/4/19
PFMenuBar01
End Sub
Function PFAddMenuBarDel()
''削除 メニューバー1 Button1 2003/4/20
' PFAddMenuBarDel
Dim myZBname As String
If myMenuNo = 2 Then
''削除 メニューバー2 Button2 2003/4/20
FMenuBar02Del
ElseIf myMenuNo = 3 Then
''削除 メニューバー2 Button2 2003/4/20
FMenuBar02Del
''削除 メニューバー3 Button3 2003/4/20
FMenuBar03Del
End If
'MsgBox myZBname & " " & myButton1
End Function
マクロ AutoExec と指定するプロシージャです。
Function StartJob()
''更新 全てのMenuBar
UpdateMenuBarALL
' mypCtrWidth = 2 'インプットボックスコントロール幅
End Function