smileyface5
02-22-2005, 03:46 AM
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??
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
Do you have any suggestions on how i could do this??
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