追加の
メニューバー 作成のプロシージャです。
共通の
メニューバー 作成のプロシージャの
myMenuNo の値を 2 に設定します。
このプロシージャを実行すると下のようになります。

各プロパティの意味は
- OnAction → 実行させるプロシージャ名
- Caption → 表示名
- BeginGroup → 仕切り線
- FaceId = 59 → フェイスボタン
Option Compare Database
Option Explicit
Dim myMID2 As Integer
Dim myButton2 As String
Dim myCaption(10) As String
Dim myAction(10) As String
Function PFMenuBar02Set01()
''設定 Caption OnAction メニューバー2 2003/4/20
' PFMenuBar02Set01
myButton2 = "Menu"
myCaption(0) = "Main Menu"
myCaption(1) = ""
myCaption(2) = ""
myCaption(3) = "DBWindow Min"
myCaption(4) = "DBWindow Restore"
myCaption(5) = "DBWindow 非表示"
myCaption(6) = "DBWindow 表示"
myCaption(7) = ""
myAction(0) = "FShowMenuBar02A"
myAction(1) = "FShowMenuBar02B"
myAction(2) = "FShowMenuBar02C"
myAction(3) = "FShowMenuBar02D"
myAction(4) = "FShowMenuBar02E"
myAction(5) = "FShowMenuBar02F"
myAction(6) = "FShowMenuBar02G"
myAction(7) = "FShowMenuBar02H"
End Function
Public Function FMenuBar02()
''更新・作成 メニューバー2 Button2 → Button4 2003/4/20
' FMenuBar02
Dim MyCB01 As CommandBarControl
Dim MyCB02 As CommandBarControl
Dim myBname As String
Dim myButtonImage1 As Integer
myMID2 = myMenuID + 1
myButtonImage1 = 59 '""
''設定 Caption OnAction メニューバー2 2003/4/20
PFMenuBar02Set01
''作成 メニューバー1 常用 2003/4/19
PFMenuBar01
''メニューバー名
myBname = CommandBars.ActiveMenuBar.name
'----------------------------------------------------------------
''2つ目のボタンの作成 (Popup) Jump
Set MyCB01 = CommandBars(myBname).Controls.Add(msoControlPopup, , , myMID2, True)
With MyCB01
.BeginGroup = True
.Caption = myButton2
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=1)
With MyCB02
.Caption = myCaption(0)
.OnAction = myAction(0)
.FaceId = myButtonImage1
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=2)
With MyCB02
.Caption = myCaption(1)
.OnAction = myAction(1)
End With
Set MyCB02 = MyCB01.Controls.Add(Type:=msoControlButton, Before:=3)
With MyCB02
.Caption = myCaption(2)
.OnAction = myAction(2)
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
End Function
Sub UpdateMenuBar02()
''更新 FMenuBar02
' UpdateMenuBar02
''作成 メニューバー2 常用 2003/4/19
FMenuBar02
End Sub
Function FMenuBar02Del()
''削除 メニューバー2 Button2 2003/4/20
' FMenuBar02Del
Dim myZBname As String
''コマンドバー名
myZBname = CommandBars.ActiveMenuBar.name
On Error Resume Next
CommandBars(myZBname).Controls(myButton2).Delete
End Function