'[開く]メニューをカスタマイズするマクロ

Option Explicit

'[開く]メニューに登録するテストマクロ

Sub MyFileOpen()
    MsgBox "MyFileOpen"
End Sub


'[開く]メニューをカスタマイズするマクロ

Sub SetMenuAction_Open_On()
    SetMenuAction_Open 1
End Sub


'[開く]メニューを復元するマクロ

Sub SetMenuAction_Open_Off()
    SetMenuAction_Open 0
End Sub


'マクロオプションを設定するマクロ

Sub MacroOption_StatusBar()
    Dim sMacro As String

    sMacro = "MyFileOpen"

    Application.MacroOptions macro:=sMacro, _
        StatusBar:=StrConv( _
            "既存のファイルを開きます。", vbNarrow)
End Sub


Sub SetMenuAction_Open(iSetting As Integer)
    Dim sMacro As String
    Dim sMenu As String
    Dim sMenuItem As String
    Dim iToolbarButtonId As Integer
    Dim oMenuBar As Object
    Dim oMenu As Object
    Dim oMenuItem As Object
    Dim oToolBar As Object
    Dim oToolbarButton As Object
    Dim iIndex As Integer

    sMacro = "MyFileOpen"

    sMenu = StrConv("ファイル(&F)", vbNarrow)
    sMenuItem = "開く(&O)..."
    iToolbarButtonId = 1

    For Each oMenuBar In Application.MenuBars
        Set oMenu = GetItemByName(oMenuBar.Menus, sMenu)
        If Not (oMenu Is Nothing) Then
            Set oMenuItem = GetItemByName(oMenu.MenuItems, sMenuItem)
            If Not (oMenuItem Is Nothing) Then
                iIndex = oMenuItem.Index
                oMenuItem.Delete
                If iSetting = 1 Then
                    Set oMenuItem = oMenu.MenuItems.Add( _
                        Caption:=sMenuItem, _
                        OnAction:=sMacro, _
                        before:=iIndex)
                Else
                    Set oMenuItem = oMenu.MenuItems.Add( _
                        Caption:=sMenuItem, _
                        before:=iIndex, _
                        restore:=True)
                End If
            End If
        End If
    Next

    For Each oToolBar In Application.Toolbars
        For Each oToolbarButton In oToolBar.ToolbarButtons
            If oToolbarButton.Id = iToolbarButtonId Then
                If iSetting = 1 Then
                    oToolbarButton.OnAction = sMacro
                Else
                    oToolbarButton.OnAction = ""
                End If
            End If
        Next
    Next

    If iSetting = 1 Then
        Application.OnKey "^o", sMacro
    Else
        Application.OnKey "^o"
    End If

End Sub


Function GetItemByName(ByVal oCollection As Object, _
    ByVal sName As String) As Object
    On Error Resume Next
    Set GetItemByName = oCollection.Item(sName)
End Function