Word自定义右键菜单的VBA代码示例

　　本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