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 (firstname.lastname@example.org) and Clif Kussmaul (email@example.com). 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