Dzwebs.Net

　　本Word的VBA代码的功能简介：在右键文本菜单的中部位置(相当于右击文本时出现的菜单)，添加一个自定义命令，并执行相应过程。

Private Sub Document_Close()
    On Error Resume Next
    Application.CommandBars("Text").Controls("Test").Delete    ’恢复原有菜单
End Sub
 
Private Sub Document_Open()
    Dim Half As Byte
    On Error Resume Next
    Dim NewButton As CommandBarButton
    Application.CommandBars("Text").Controls("Test").Delete    ‘预防性删除
    Half = Int(Application.CommandBars("Text").Controls.Count / 2)    ‘中间位置
    Set NewButton = Application.CommandBars("Text").Controls.Add(Type：=msoControlButton， Before：=Half)
    With NewButton
        .Caption = "Test"        ’命令名称
        .FaceId = 100        ’命令的FaceId
        .Visible = True          ’可见
        .OnAction = "MySub" ‘指定响应过程名
    End With
End Sub
 
Sub MySub()
    MsgBox "It’s A Test For CommandBars(""Text"")!"， vbOKOnly + vbInformation
End Sub
 
Sub ComReset()    ‘重新设置右键菜单，彻底恢复默认设置
    Application.CommandBars("Text").Reset
End Sub
 
生成具有Commandbars(“Toolbar list”)或者当于CommandBars("View").Controls("工具栏(&T)")中的命令按钮形式：
Private Sub Document_Close()
    On Error Resume Next
    Application.CommandBars("Text").Controls("New Menu").Delete    ’恢复原有菜单
End Sub
 
Private Sub Document_Open()
    Dim i As Byte， Half As Byte， strName As String， NewButton As CommandBarPopup
    Dim MenuAdd As CommandBarButton
    On Error Resume Next
    Application.CommandBars("Text").Controls("New Menu").Delete    ‘预防性删除
    Half = Int(Application.CommandBars("Text").Controls.Count / 2)    ‘中间位置
    Set NewButton = Application.CommandBars("Text").Controls.Add(Type：=msoControlPopup， Before：=Half)
    With NewButton          ’这是弹出式菜单即右边带有小三角型的
        .Caption = "New Menu"    ’命令名称
        .Visible = True    ‘可见
    End With
    For i = 1 To 4    ’新建四个子命令，批量生成
        strName = "Menu" & i
        Set MenuAdd = NewButton.Controls.Add(Type：=msoControlButton)
        With MenuAdd
            .Caption = strName
            .OnAction = "MySub"
            .State = msoButtonDown    ‘带勾选的命令按钮
            .Visible = True
        End With
    Next
End Sub
 
Sub MySub()
    Dim ActionTag As String
    ActionCap = CommandBars.ActionControl.Caption
    MsgBox ActionCap
       Select Case ActionTag
              ’以此来区分各个命令并执行指定过程
       End Select
    With Application.CommandBars("Text").Controls("New Menu")
        If .Controls(ActionCap).State = msoButtonDown Then
            MsgBox "It’s A Test!"， vbOKOnly + vbInformation
            .Controls(ActionCap).State = msoButtonUp
        Else
            .Controls(ActionCap).State = msoButtonDown
        End If
    End With
End Sub
 
Sub ComReset()    ‘重新设置右键菜单，彻底恢复默认设置
    Application.CommandBars("Text").Reset
End Sub
以下为禁用命令和快捷键的常用方式与保存路径，提倡使用修改WORD命令更方便。
Sub Example()
‘将自定义菜单栏\工具栏或者自定义键盘的改变保存于活动文档中
    Application.CustomizationContext = ActiveDocument
    ‘利用CommandBars(Name).Controls(Caption)来定位按钮，具有唯一性
    Application.CommandBars("Standard").Controls("打开(&O)...").Enabled = False    ‘TRUE
    ‘ 利用来定位按钮，不太直观，容易受调整后的命令位置干扰
    Application.CommandBars("Standard").Controls(2).Enabled = True    ‘False
    ‘利用Findcontrol(ID：=)来定位按钮，具有唯一性，并可循环，作用多个此按钮命令
    Application.CommandBars.FindControl(ID：=23).Enabled = True    ‘False
    ‘利用CommandBars(Index).Controls(Index)来定位按钮，直观，但受调整后的命令位置干扰
    Application.CommandBars(1).Controls(2).Enabled = False    ‘True
End Sub
 
Sub FileOpen()    ‘可以将命令与快捷键一并禁用
    MsgBox "这是修改WORD命令/打开文件"
End Sub
 
Sub Sample()       ’将 CTRL+O快捷键重新分配或者修改并保存于当前文档中
    CustomizationContext = ActiveDocument
    KeyBindings.Add KeyCode：=BuildKeyCode(wdKeyControl， wdKeyO)， _
KeyCategory：=wdKeyCategoryMacro， Command：="NoFileOpen"
End Sub
 
Sub NoFileOpen()
    MsgBox "This is only a test!"
End Sub