-
vba popup menu for word
i am trying to create a new spell and grammar check in word. i am able to underline words that are spelt incorrectly however i would like to be able to right-click mis-spelt words and for a popup menu to appear with alternative words. I am trying the following code but i am having great problems with it as it generates a new menu item everytime i run the program and i try to delete the new menu item every time but it doesnt work and throws an error.
Do you have any suggestions on how i could do this??
[vba]
Sub AddMenu()
Dim ShortCutMenu As CommandBar
Dim Menu As CommandBarPopup
Dim ctrl As CommandBarControl
'If Selection.Font.Underline = wdUnderlineWavy Then
Set ShortCutMenu = CommandBars("text")
Set Menu = ShortCutMenu.Controls.Add(Type:=msoControlPopup, temporary:=True)
With Menu
.BeginGroup = True
.Caption = "&GaelScr?obh"
' .OnAction = "AccessThesaurusMenu"
End With
System.Cursor = wdCursorWait
'Set Menu = CommandBars.ActionControl
With Selection
.Expand wdWord ' Select insertion point word.
' Deselect any trailing spaces.
Do While Right(.Text, 1) = Chr(32)
.MoveLeft Unit:=wdCharacter, _
Count:=1, Extend:=wdExtend
Loop
selWord$ = Trim(.Text) ' Store selection.
MsgBox selWord$
End With
Menu.delete
End Sub[/vba]
-
I think this might help you :)
Okay - it looks like one of your problems is one i've had myself.
[vba]
'<>
Dim myMenuName As String 'If you name your menu its easier to delete
'<>
Dim ShortCutMenu As CommandBar
Dim Menu As CommandBarPopup
Dim ctrl As CommandBarControl
'If Selection.Font.Underline = wdUnderlineWavy Then
myMenuName = "My Custom Menu"
Set ShortCutMenu = CommandBars("text")
' Set Menu = ShortCutMenu.Controls.Add(Type:=msoControlPopup, 'temporary:=True)
'<>
'Change Set statement to include toolbars name
Set Menu = ShortCutMenu.Controls.Add(Name:= myMenuName,
Type:=msoControlPopup, Temporary:=True)
' <>
With Menu
.BeginGroup = True
.Caption = "&GaelScr?obh"
' .OnAction = "AccessThesaurusMenu"
End With
System.Cursor = wdCursorWait
'Set Menu = CommandBars.ActionControl
With Selection
.Expand wdWord ' Select insertion point word.
' Deselect any trailing spaces.
Do While Right(.Text, 1) = Chr(32)
.MoveLeft Unit:=wdCharacter, _
Count:=1, Extend:=wdExtend
Loop
selWord$ = Trim(.Text) ' Store selection.
MsgBox selWord$
End With
'<>
On Error Resume Next
Application.CommandBars(MenuName).Delete
'This little piece checks that you toolbar doesnt exist already,
'if it does it deletes it if it does
'<>
Menu.delete '<- so this is no longer neccessary
[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules