メニューバー 共通
共通の メニューバー 作成のプロシージャです。
マクロ AutoExec で起動時に作成(更新)します。
個々のデータベースのメニューバーは、この後ろに追加するようにします。
このプロシージャを実行すると下のようになります。
access01
各プロパティの意味は
  1. OnAction → 実行させるプロシージャ名
  2. Caption → 表示名
  3. BeginGroup → 仕切り線
  4. FaceId = 59 → フェイスボタン
  5. 追加メニューバー数は必要に応じて指定します。(三つまで)

メニューバー BACK ▲ TOP
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▲ TOP
マクロ AutoExec と指定するプロシージャです。 acc02
Function StartJob()

''更新 全てのMenuBar
    UpdateMenuBarALL
    
'    mypCtrWidth = 2               'インプットボックスコントロール幅

End Function

top