My wife is a professor, and I found out she’s been manually creating randomized versions of her tests (to reduce cheating) by hand for years, along with all of the other faculty in her department. She uses Word 2007 and 2010 to write her tests, so I set about writing a VBA macro to do this tedious process for her.
Her tests include images, lists, and other formatting, so straight text copying won’t work. All questions that reference the same images are on the same page, otherwise each question gets it’s own page. The first page contains instructions and needs to be included at the beginning of a randomized test doc, but all other pages need to be randomized in a new document. After the randomization process, I am removing page breaks so that questions are neatly on as few pages as possible.
So far I haven’t been able to transfer Ranges taken from the Page collection to the new document without losing the formatting information. I’ve googled all over the place, but I haven’t found any indications of what I’m doing wrong yet.
My code thus far:
Sub CreateTestVersions()
Dim ThisDoc As Document
Dim NewDoc As Document
Dim Pgs As pages
Dim Question As Range
Let Skip = 1 'Number of pages to skip randomizing
Set ThisDoc = Application.ActiveDocument
Set NewDoc = Documents.Add 'Create new document
Set Pgs = ThisDoc.Windows(1).Panes(1).pages 'Pages collection
ReDim Questions(1 To Pgs.Count - Skip) As Range
For p = 1 To Skip 'Add skipped pages to begining of new document
NewDoc.Content = NewDoc.Content & Pgs(p).Rectangles(1).Range
Next
' Add questions to an array of ranges
For q = LBound(Questions) To UBound(Questions)
Set Question = Pgs(q + Skip).Rectangles(1).Range
'Keep questions on a single page, don't split accross pages
Question.Paragraphs.KeepTogether = True
' All lists, text formatting, etc. is lost for some reason
Set Questions(q) = Question ' Needs fixed
Next
'Randomization needs to happen here
'Add randomized questions to new document
For q = LBound(Questions) To UBound(Questions)
NewDoc.Content = NewDoc.Content & Questions(q)
Next
'Remove page breaks
With NewDoc.Content.Find
.Text = "^m"
.Forward = True
.Wrap = wdFindStop
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub
I’m using the Questions array because I figure that will be easier to randomize, especially when I expand this code to generate more than one version. I’d also like to avoid using Select, Copy, Paste if at all possible.
Any insight on why I’m losing formatting and what the proper approach should be is appreciated.
I did manage to get this to work using InsertFile and adding ranged bookmarks around each question. Here is the finished product. Hopefully it will help some other people out!