Results 1 to 2 of 2
  1. #1
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Accumulate synonyms (Word97/sr2)

    <pre>Sub BuildChoices()
    Dim strWord As String
    If Selection.Range.Start = Selection.Range.End Then
    Selection.Words(1).Select
    Else
    End If
    strWord = Trim(Selection.Text)
    Dim strTotal As String
    strTotal = ""
    While strWord <> ""
    strTotal = strTotal & " " & Trim(strWord)
    strWord = InputBox$("Please enter one or more words separated by spaces", "BuildChoices", strTotal)
    If strWord = strTotal Then strWord = ""
    Wend
    MsgBox "Choices are " & strTotal
    End Sub
    </pre>


    Here's a crude method of accumulating sysnonyms based on a given word.

    The user (usually you, hence "youser") has clicked within or selected a word, and wants to provide a list of sysnonyms.

    The macro loops untilt he input box is found to be empty, or unchanged after the call (user merely chose OK).

    What you DO with the sysnonyms is up to you, but see here, because I'm working on it!

  2. #2
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Yilgarn region of Toronto, Ontario
    Posts
    5,453
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Accumulate synonyms (Word97/sr2)

    Here is some code that inserts nested fields to generate strings based on a randomized time value.

    The code makes use of strSplitStringAt which ("true") returns the left-most delimited word from a string and ("false") returns ALL BUT the left-most delimited word from a string

    <pre>Sub TESTDumpIfs()
    ' test the procedures to nest IF fields.
    Selection.EndKey unit:=wdStory
    Selection.TypeParagraph
    Call DumpIfs(15, 15, "alpha beta gamma delta", " ")
    End Sub
    Public Function DumpIfs(intInterval As Integer, intPoint As Integer, strWords As String, strDelim As String)
    ' If we are down to the last two strings, dump them, else dump one and recurse(nested IF fields)
    Dim intCount As Integer
    intCount = U.intCountWords(strWords, strDelim)
    If intCount <= 2 Then
    Call InsertFieldTwoStrings(intPoint, U.strsplitstringat(strWords, strDelim, True), _
    U.strsplitstringat(strWords, strDelim, False))
    Else
    Call InsertFieldOneStrings(intPoint, U.strsplitstringat(strWords, strDelim, True))
    Call DumpIfs(intInterval, intPoint + intInterval, U.strsplitstringat(strWords, strDelim, False), strDelim)
    End If
    End Function
    Public Function InsertFieldTwoStrings(intPoint As Integer, strWord1 As String, strWord2 As String)
    ' Insert the last two strings
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
    Selection.TypeText Text:="IF "
    Call InsertRndField
    Selection.MoveRight unit:=wdCharacter, Count:=2
    Selection.TypeText "<" & Str(intPoint) & " " & strWord1 & " " & strWord2 & " "
    End Function
    Public Function InsertFieldOneStrings(intPoint As Integer, strWord1 As String)
    ' Insert a string to be used, and recursively continue down the string.
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
    Selection.TypeText Text:="IF "
    Call InsertRndField
    Selection.MoveRight unit:=wdCharacter, Count:=2
    Selection.TypeText "<" & Str(intPoint) & " " & strWord1 & " "
    End Function
    Public Function InsertRndField()
    ' Insert a field to return a value 0 through 59 a la Andrew Lockton
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
    Selection.TypeText "time @ ""s"""
    End Function
    </pre>


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •