呵呵,测试了一下,原来是这样的: '* +++++++++++++++++++++++++++++ '* Created By 守柔(ShouRou)@ExcelHome 2005-1-23 10:27:40 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* -----------------------------
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 .Tag = strName End With Next End Sub '---------------------- Sub MySub() Dim ActionTag As String ActionTag = CommandBars.ActionControl.Tag MsgBox CommandBars.ActionControl.Tag With Application.CommandBars("Text").Controls("New Menu") If .Controls(ActionTag).State = msoButtonDown Then MsgBox "It's A Test!", vbOKOnly + vbInformation .Controls(ActionTag).State = msoButtonUp Else .Controls(ActionTag).State = msoButtonDown End If End With End Sub '---------------------- Sub ComReset() '重新设置右键菜单,彻底恢复默认设置 Application.CommandBars("Text").Reset End Sub '---------------------- |