メニューバー 追加
追加の メニューバー 作成のプロシージャです。
共通の メニューバー 作成のプロシージャの myMenuNo の値を 2 に設定します。
このプロシージャを実行すると下のようになります。
acc03
各プロパティの意味は
  1. OnAction → 実行させるプロシージャ名
  2. Caption → 表示名
  3. BeginGroup → 仕切り線
  4. FaceId = 59 → フェイスボタン

メニューバー 追加▲ TOP
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

top