Creating a cloze test using Word VBA - vba

Question

As a beginner, I am trying to write a Word Macro that can automatically mark and convert one third of the words in an article to a cloze format. In the past, I have manually added equal signs before the desired word and then ran the following macro to complete the process. However, I am now attempting to automate this manual step by creating a new macro that will randomly add equal signs to the prefixes of the words in one-third of the selected range. After running this new macro, I plan to use the previous macro to finish the conversion to the cloze format. However, I am unsure how to set up the new macro to perform the marking and would appreciate any suggestions or guidance.
This is the conversion macro that is already done:
Sub Convert()
Application.ScreenUpdating = False
selection.HomeKey Unit:=wdStory 'init
Dim iCount, A, i As Long
Dim RPT, CHAR, WordRpt, Eventual As Integer
iCount = 0
WordRpt = 1
Eventual = 0
selection.Find.ClearFormatting 'A and I
selection.Find.Replacement.ClearFormatting
selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find 'sum A
.text = "=a "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
A = A + 1
Loop
End With
selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find 'sum I
.text = "=i "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
i = i + 1
Loop
End With
With selection.Find
.text = "=a "
.Replacement.text = "_ "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
selection.Find.Execute replace:=wdReplaceAll
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "=i "
.Replacement.text = "_ "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
selection.Find.Execute replace:=wdReplaceAll
With ActiveDocument.Content.Find 'sum equals
.text = "="
.Format = False
.Wrap = wdFindStop
Do While .Execute
iCount = iCount + 1
Loop
End With
While WordRpt <= iCount
WordRpt = WordRpt + 1
With selection.Find 'next equal
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="="
selection.TypeBackspace
selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
CHAR = Len(selection) - 2
selection.MoveLeft Unit:=wdCharacter, Count:=1
selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
selection.Cut
selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
selection.PasteAndFormat (wdFormatOriginalFormatting)
UdsRpt = 1 'underscore
Do While UdsRpt <= CHAR
UdsRpt = UdsRpt + 1
selection.TypeText text:="_"
Loop
selection.TypeText text:=" "
End With
Wend
'
' patch comma
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ,"
.Replacement.text = "__,"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch period
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ."
.Replacement.text = "__."
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch question mark
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ?"
.Replacement.text = "__?"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch excalmation mark
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ !"
.Replacement.text = "__!"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch slash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ /"
.Replacement.text = "__/"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch back slash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ \"
.Replacement.text = "__\"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch colon
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ :"
.Replacement.text = "__:"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch semi colon
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ;"
.Replacement.text = "__;"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch dash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ –"
.Replacement.text = "__–"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch hyphen
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ -"
.Replacement.text = "__-"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch ellipsis
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ …"
.Replacement.text = "__…"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
Eventual = A + i + iCount
MsgBox "Successfully converted" & Eventual & "words.", vbOKOnly, "Task Completed"
Application.ScreenUpdating = True
End Sub

Answer 1

This simple macro will insert an equals sign before words in a selection with a probability of 1 in 3.
Sub InsertEqualsSigns()
Randomize
Dim targetWord As Range
For Each targetWord In Selection.Range.Words()
targetWord.Select
Selection.MoveLeft Unit:=wdWord, Count:=1
If Rnd() < 1 / 3 Then
Selection.TypeText Text:="="
End If
Next
End Sub
Note that this is currently just set to add an equals sign, so change the text to insert "=a " or "=i " as preferred as I'm not sure the exact close formatting.