Parts of Speech of the WordList in excel using vba

[sanits591]

I have come across another code, which does the similar function in MS Word, like antonyms, but it does for "Parts of Speech".

Now, what i would be requesting to have the code in excel VBA, that there is a WordList in Col A, and all the parts of speech are marked on the top row in the columns to the right, e.g. Col-B-Adjective, Col-C-Adverb, Col-D-Conjunction and so on.

As soon as the code is run, then all the cells from the Col-b to right gets filled up with appropriate word with respect to the header row, i.e. Parts of Speech of the Col A.

The below code does this in MS Word, probably this would be assisting in developing in Excel.

Anticipatory thanks!

Sub parts_of_speech()

Set mySynInfo = Selection.Range.SynonymInfo
If mySynInfo.MeaningCount <> 0 Then
    myList = mySynInfo.MeaningList
    myPos = mySynInfo.PartOfSpeechList
    For i = 1 To UBound(myPos)
'wdAdjective, wdAdverb, wdConjunction, wdIdiom, wdInterjection, wdNoun, wdOther, wdPreposition, wdPronoun, and wdVerb.
        Select Case myPos(i)
            Case wdAdjective
                 pos = "adjective"
            Case wdNoun
                 pos = "noun"
            Case wdAdverb
                 pos = "adverb"
            Case wdVerb
                 pos = "verb"
            Case wdConjunction
                 pos = "Conjunction"
            Case wdIdiom
                pos = "Idiom"
            Case wdInterjection
                pos = "Interjection"
            Case wdPreposition
                pos = "Preposition"
            Case wdPronoun
                pos = "Pronoun"

            Case Else
                 pos = "other"
        End Select
        MsgBox myList(i) & " found as " & pos
    Next i
Else
    MsgBox "There were no meanings found."
End If

End Sub

 

[Ruddles]

I suggest you try this code in Word first. I'm not sure it works in quite the way you're expecting.

 

[sanits591]

Yes, the below code works fine in MS Word, need to paste in the MS Word VBA Standard module.


I am seeking for a similar way, as jonmo1 resolved for Antonyms in the earlier post.


Thanks!

Sub parts_speech()
Set mySynInfo = Selection.Range.SynonymInfo
If mySynInfo.MeaningCount <> 0 Then
myList = mySynInfo.MeaningList
myPos = mySynInfo.PartOfSpeechList
For i = 1 To UBound(myPos)
Select Case myPos(i)
Case wdAdjective
pos = "adjective"
Case wdNoun
pos = "noun"
Case wdAdverb
pos = "adverb"
Case wdVerb
pos = "verb"
Case Else
pos = "other"
End Select
MsgBox myList(i) & " found as " & pos
Next i
Else
MsgBox "There were no meanings found."
End If
End Sub

 

[Ruddles]

Try this. Paste the code into a new general code module and add a reference to the Microsoft Word Object Library. Put your lookup words in column A. Select the ones you want to look up and run the macro.

Any good?

Option Explicit
 
Public Sub PartsOfSpeech()
 
  Dim mObjWord As Word.Application
  Dim mySynInfo As Word.SynonymInfo
  Dim myList As Variant
  Dim myPos As Variant
  Dim i As Integer
  Dim iMax As Integer
  Dim thisPos As String
  Dim oCell As Range
 
  Set mObjWord = CreateObject("Word.Application")
 
  iMax = 1
 
  For Each oCell In Selection
    oCell.Offset(0, 1).Resize(1, 99).ClearContents
    If oCell.Column = 1 And Not IsEmpty(oCell) Then
      Set mySynInfo = SynonymInfo(Word:=oCell.Value, LanguageID:=wdEnglishUS)
      oCell.Offset(0, 1) = "'(" & CStr(mySynInfo.MeaningCount) & ")"
      If mySynInfo.MeaningCount <> 0 Then
        myList = mySynInfo.MeaningList
        myPos = mySynInfo.PartOfSpeechList
        If i > iMax Then iMax = i
        For i = 1 To UBound(myPos)
          Select Case myPos(i)
            Case wdAdjective
              thisPos = "adjective"
            Case wdNoun
              thisPos = "noun"
            Case wdAdverb
              thisPos = "adverb"
            Case wdVerb
              thisPos = "verb"
            Case wdConjunction
              thisPos = "conjunction"
            Case wdIdiom
              thisPos = "idiom"
            Case wdInterjection
              thisPos = "interjection"
            Case wdPreposition
              thisPos = "preposition"
            Case wdPronoun
              thisPos = "pronoun"
             Case Else
              thisPos = "other"
          End Select
          oCell.Offset(0, i + 1) = myList(i) & " (" & thisPos & ")"
        Next i
      Else
        oCell.Offset(0, 2) = "No meanings found"
      End If
    End If
  Next oCell
 
  For i = 3 To iMax
    Columns(i).EntireColumn.AutoFit
  Next i
 
End Sub

 

[sanits591]

You really did it. Ruddles, you are always been a very helpful guy in resolving my problems.

Thanks a Lot!

 

[Ruddles]

Thanks for the feedback. The invoice is going out to you in tonight's post!

On a serious note, I've learned something because I had no idea how to do this before you asked. So thanks to you too!

 

[makiwara]

Hi! I
- insert my word list to column "A"
- and add the word office library as reference
- and in the end I select the cells in column "A" which I want to examine.

But the code crashes: "User defined type not defined" and then highlights this row:
Dim mObjWord As Word.Application

Any idea? Thank you for your answer have a nice day!

Thanks for the feedback. The invoice is going out to you in tonight's post!

On a serious note, I've learned something because I had no idea how to do this before you asked. So thanks to you too!

 

[DanDanTheCheerleadingMan]

Just seconding @makiwara's comment as well.

 

[Ruddles]

Have you added a reference to the Microsoft Word Object Library - Tools > References in the VB Editor?

 

[Macropod]

See also: https://www.mrexcel.com/forum/excel...ent-parts-speech-post4700778.html#post4700778