The VBA function below can be used to create student versions from an instructor version of an activity in MS Word, as follows:
- Create and save a MS Word file with the learning activity.
- In the “Developer” tab, click on “Macros” and “Create”, and copy the VBA code below.
- 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.
- Apply the “Answer” style to all sample answers, instructor notes, etc.
- Run the removeAnswers() function, which will copy the file with “-student” appended to the name, and then remove all text in the “Answer” style.
- Review the student version and correct any problems.
' 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 (laurent.babout@p.lodz.pl) and Clif Kussmaul (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
