Word macro to add html tags to specific parsed phrases

[mpeterson]

Hi Guys,

I have a text file that contains over eight thousand of multiple choice questions each is followed by an empty paragraph to separate it from the following question, as per the following example:

Type: MC
1) What is the effect of releasing a ball in positive gravity?
~ It will fall down. (This is the correct answer) It will retain its mass. (This answer is true but unrelated) It will rise. (This answer is false but related) Its shape will change. (This answer is false and unrelated) It will explode. (This answer is false and unrelated)
@ IncorrectIt will fall down. (This is the correct answer) It will retain its mass. (This answer is true but unrelated) It will rise. (This answer is false but related) Its shape will change. (This answer is false and unrelated) It will explode. (This answer is false and unrelated)
*a. It will fall down
b. It will retain its mass
c. It will rise
d. Its shape will change
e. It will explode

I'm requested to edit this file by changing the colour of all the items in the two paragraphs that start with "Tilde ~" and "Ampersand @" as long as these phrases exist in the list of alternative answers "a. – k.". In other words to parse the list of alternative answers for each question (in my example a. to e.), and only change their corresponding phrases in the above two paragraphs that start with "~" and "@", by adding relevant html tags. Thus each question will become as follows:

Type: MC
1) What is the effect of releasing a ball in positive gravity?
~ <font color = "#008000">It will fall down</font>. (This is the correct answer) <font color = "#008000">It will retain its mass</font>. (This answer is true but unrelated) <font color = "#008000">It will rise</font>. (This answer is false but related) <font color = "#008000">Its shape will change</font>. (This answer is false and unrelated) <font color = "#008000">It will explode</font>. (This answer is false and unrelated)
@ <font color = "#008000">It will fall down</font>. (This is the correct answer) <font color = "#008000">It will retain its mass</font>. (This answer is true but unrelated) <font color = "#008000">It will rise</font>. (This answer is false but related) <font color = "#008000">Its shape will change</font>. (This answer is false and unrelated) <font color = "#008000">It will explode</font>. (This answer is false and unrelated)
*a. It will fall down
b. It will retain its mass
c. It will rise
d. Its shape will change
e. It will explode

.. another question

.. another question

Can someone help with this request please? Many thanks in advance.

[gmaxey]

Interesting challenge. The following code is based on the structure you have defined and tested only on a small sample of text. It requires that each set (the question type, question, ~ text, @ text, and answers each consist of a single paragraph. So in your example the set is 9 paragraphs total. Each set is delimited from the other sets by a empty paragraph:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim strFind As String
Dim oRng As Word.Range
Dim oRngBox As Word.Range
Dim oSrchRng As Word.Range
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseStart
Do
Do
On Error Resume Next
oRng.MoveEnd wdParagraph
If Err.Number <> 0 Then Exit Do
Loop Until oRng.Characters.Last.Next = Chr(13)
On Error GoTo 0
For lngIndex = 5 To oRng.Paragraphs.Count
strFind = oRng.Paragraphs(lngIndex).Range.Text
strFind = Right(strFind, Len(strFind) - InStr(strFind, ".") - 1)
strFind = Left(strFind, Len(strFind) - 1)
Set oSrchRng = oRng.Paragraphs(3).Range
Set oRngBox = oSrchRng.Duplicate
Selection.Find.ClearFormatting
With oSrchRng.Find
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
.InsertBefore "<font color = ""#008000"">"
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Set oSrchRng = oRng.Paragraphs(4).Range
With oSrchRng.Find
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
.InsertBefore "<font color = ""#008000"">"
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
oRng.MoveStart wdParagraph, 1
Loop Until oRng.End = ActiveDocument.Range.End - 1
End Sub



Please visit my website: http://gregmaxey.mvps.org/word_tips.html

[mpeterson]

Fabulous, really genius code Greg, I'm really stunned as I ran the code and it did what is expected. Nevertheless, there three things still pending:
1. the code does change relevant texts in the paragraph that starts with ampersand, but it totally ignores the second paragraph that starts with tilde, accordingly no change happens on it.
2. when running the code on questions with long alternatives (over 40 words per alternative), the code halts on line 19 where "." is, with a message "parameter too long".
3. can we make the right answer distinctive by giving it a different colour such as #1A06FB, keeping the rest of items in colour #008000? The right answer is always marked with an * before the letter of its item; in my example it is item "a." (*a.)

I'm more than appreciating for your input to this matter; really I don't know how to thank you.

[gmaxey]

mpeterson,

1) It looks like I forgot to add "Set oRngBox = oSrchRng.Duplicate" immediately after "Set oSrchRng = Set oSrchRng = oRng.Paragraphs(4).Range
2) This is a problem. It should be failing on the line .Text = strFind because the string length of that parameter is limited to 255 characters. I think the best I could do gratis is hightlight those instances and hopefully there are not a lot of them. You can then go back and add the closing tag.
3. Sure


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngIndex As Long
Dim strFind As String
Dim oRng As Word.Range
Dim oRngBox As Word.Range
Dim oSrchRng As Word.Range
Dim bCorrect As Boolean, bTooLong As Boolean
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseStart
Do
Do
On Error Resume Next
oRng.MoveEnd wdParagraph
If Err.Number <> 0 Then Exit Do
Loop Until oRng.Characters.Last.Next = Chr(13)
On Error GoTo 0
For lngIndex = 5 To oRng.Paragraphs.Count
bCorrect = False
bTooLong = False
strFind = oRng.Paragraphs(lngIndex).Range.Text
If Left(strFind, 1) = "*" Then bCorrect = True
strFind = Right(strFind, Len(strFind) - InStr(strFind, ".") - 1)
strFind = Left(strFind, Len(strFind) - 1)
Set oSrchRng = oRng.Paragraphs(3).Range
Set oRngBox = oSrchRng.Duplicate
Selection.Find.ClearFormatting
With oSrchRng.Find
If Len(strFind) > 255 Then bTooLong = True
If Not bTooLong Then
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
If bCorrect Then
.InsertBefore "<font color = ""#1A06FB"">"
Else
.InsertBefore "<font color = ""#008000"">"
End If
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
Else
.Text = Left(strFind, 255)
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If bCorrect Then
.InsertBefore "<font color = ""#1A06FB"">"
Else
.InsertBefore "<font color = ""#008000"">"
End If
.HighlightColorIndex = wdYellow
.Collapse wdCollapseEnd
End With
End If
Wend
End If
End With
Set oSrchRng = oRng.Paragraphs(4).Range
Set oRngBox = oSrchRng.Duplicate
With oSrchRng.Find
If Len(strFind) > 255 Then bTooLong = True
If Not bTooLong Then
.Text = strFind
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If oSrchRng.Characters.Last.Next = "." Then oSrchRng.MoveEnd wdCharacter, 1
If bCorrect Then
.InsertBefore "<font color = ""#1A06FB"">"
Else
.InsertBefore "<font color = ""#008000"">"
End If
.InsertAfter "</font>"
.Collapse wdCollapseEnd
End With
End If
Wend
Else
.Text = Left(strFind, 255)
While .Execute
If oSrchRng.InRange(oRngBox) Then
With oSrchRng
If bCorrect Then
.InsertBefore "<font color = ""#1A06FB"">"
Else
.InsertBefore "<font color = ""#008000"">"
End If
.HighlightColorIndex = wdYellow
.Collapse wdCollapseEnd
End With
End If
Wend
End If
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
oRng.MoveStart wdParagraph, 1
Loop Until oRng.End = ActiveDocument.Range.End - 1
End Sub

[mpeterson]

Magnificent Greg. It is working like magic. Please accept my deep respect and gratitude. Thank you.

[gmaxey]

It was fun. Glad I could help. As for the thanks, do they not brew beer anymore in Australia? You can buy me one next time I'm over.

[mpeterson]

You're welcome any time "mate" :)

[mpeterson]

Dear Greg,
Over two years ago, I requested help in this thread and you generously and professionally provided it. Since then, I have been using your code which did a lot of work for me.
Due to the increasing amount of work needed by this code, manual work of running it on a file and saving it has become a very tedious and time consuming task. The number of files that need html tags application is over 15000!!
I was thinking, if it is possible, to automate running your code by another code that does the following:
1. Opens one file.doc at a time from "c:\before_conversion" folder,
2. Runs your masterpiece code to apply html tags,
3. Saves the converted file in the same name but in another folder named "c:\after_conversion", and
4. Goes for the following file in "before_conversion" folder to do the same three processes till the end of all files in this folder.

I actually preferred asking you first, simply because I know who is Greg Maxey, and it is only you who'd tell me to post it on a new thread.

Very much appreciated.

[gmaxey]

mpeterson,

Certainly possible. I'm headed out for the day but take a look at my http://gregmaxey.com/word_tip_pages/process_batch_folder_addin.html which I believe you could apply to your process or if that seems too daunting then just search this group for examples using the Dir function.

[mpeterson]

Thank you very much for your reply, I will see what I can do.

Always appreciating your assistance. Thank you.