Skip to content

VBA Script for MS Word

The VBA script below can be used to create student versions from an instructor version of an activity in MS Word, as follows:

  1. Create and save a MS Word file with the learning activity.
  2. In the “Developer” tab, click on “Macros” and “Create”, and copy the VBA code below.
  3. Define a new style named “Answer”. It should use the same font size and spacing as normal, but be visually different, e.g. in color and/or italics.
  4. Apply the “Answer” style to all sample answers, instructor notes, etc.
  5. Run the removeAnswers() function, which will copy the file with “-student” appended to the name, and then remove all text in the “Answer” style.
  6. Review the student version and correct any problems.

Download VBA Script

' removeAnswers()
' Copyright (c) 2022 Politechnika Lodzka (Lodz University of Technology)
' This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International License.
' Developed by [Laurent Babout](../people/Laurent-Babout.md) (laurent.babout@p.lodz.pl) and [Clif Kussmaul](../people/Clif-Kussmaul.md) (clif@kussmaul.org).

Sub removeAnswers()
    Dim i     As Long
    Dim rng   As Range
    Dim c     As Cell
    Dim p     As Paragraph
    Dim o     As OMath
    Dim fName As String
    Dim fPath As String
    Dim nName As String

    fPath = ActiveDocument.Path ' location on disc
    oName = ActiveDocument.Name ' (old) filename
    nName = Mid(oName, 1, InStr(1, oName, ".doc") - 1) & "-student.docx"
    ActiveDocument.SaveAs2 (fPath & "/" & nName) ' save as new file for student instructions

    Set rng = ActiveDocument.Range        ' range object that contains all the text of the current active document (where the cursor is)

    For Each o In rng.OMaths              ' first look at all equations in the file
        If o.Range.Style = "Answer" Then  ' check their style and remove as needed
            o.Range.Style = wdStyleNormal
            o.Range.Delete
        End If
    Next
    'For Each p In rng.Paragraphs             ' then look at paragraphs
    For i = rng.Paragraphs.Count To 1 Step -1 ' loop backwards to avoid problems
        Set p = rng.Paragraphs(i)
        If p.Style = "Answer" Then            ' check their style and remove as needed
            'p.Range.Delete
            p.Style = wdStyleNormal
            If p.Range.Tables.Count > 0 Then
                p.Range.Text = ""
            Else
                p.Range.Text = vbCrLf
            End If
        End If
    Next

    ActiveDocument.Save
End Sub