Creating a cloze test using Word VBA-CodePudding

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

CodePudding user response：

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.