Private Sub CommandButton1_Click()

Dim mySynObj As Object
Dim SList As Variant
Dim i As Long
StrOut As String


Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend




Set mySynObj = Selection.Range.SynonymInfo
SList = mySynObj.SynonymList(1)
For i = 1 To UBound(mySynObj.SynonymList(1))
  StrOut = StrOut & vbCr & SList(i)
Next i
MsgBox "Synonyms for " & mySynObj.Word & " are:" & StrOut
End Sub