Re: Can an outline be scrambled randomly?

[Stefan Blom]

You can use ALT+SHIFT+UP ARROW and ALT+SHIFT+DOWN ARROW to move
selected paragraphs up and down, respectively.

--
Stefan Blom
Microsoft Word MVP

"Nikki Rohrback" <Nikki Rohr...@discussions.microsoft.com> wrote in
message news:9D67490D-567A-4B44...@microsoft.com...
> We use a numbered outline to create Multiple Choice Exams. When we
need
> several versions of the same exam (same questions in a different
order), I
> have to cut and paste manually, which is time consuming.
WordPerfect had a
> tool to automatically scramble. Is there a way to do this easily in
Word?

[Rohrback@discussions.microsoft.com Nikki Rohrback]

But that is still time consuming. I'm looking for a way to randomly scramble
all of them (sometimes 50 questions and the respective answers) at one shot.

[Stefan Blom]

It's a little faster than copy and paste, but you're right, it would
still be time-consuming. Perhaps someone can suggest a macro solution?

--
Stefan Blom
Microsoft Word MVP

"Nikki Rohrback" <Nikki Rohr...@discussions.microsoft.com> wrote in

message news:1A6D4E29-4D2F-475E...@microsoft.com...

[Klaus Linke]

"Stefan Blom" <no....@please.xyz> wrote:
> It's a little faster than copy and paste, but you're right, it would
> still be time-consuming.
> Perhaps someone can suggest a macro solution?

I posted a macro for shuffling table rows a few years ago.
I changed it to work with paragraphs. Perhaps it'll do the trick.
It's fast, but you loose formatting -- Hope that's not a problem.

Regards,
Klaus

Sub RandomiseRows()
Dim myString
Dim myParasCount
Dim myStringArray
Dim i, i1, i2
' Read text into a string ...
myParasCount = Selection.Paragraphs.Count
myString = Selection.Text
' ... and delete the text:
Selection.Delete
myStringArray = Split(myString, Chr(13))
' Interchange two lines
For i = 0 To myParasCount - 1
i1 = Int(myParasCount * Rnd)
myString = myStringArray(i1)
myStringArray(i1) = myStringArray(i)
myStringArray(i) = myString
Next i
myString = Join(myStringArray, Chr(13))
' Reinsert text ...
Selection.TypeText myString
End Sub

[Stefan Blom]

Well, since the OP uses an outline, she probably wants to keep the
styles and, also, keep all subordinate paragraphs with their
"parents".

--
Stefan Blom
Microsoft Word MVP

"Klaus Linke" <in...@fotosatz-kaufmann.de> wrote in message
news:Oj7lKioV...@TK2MSFTNGP14.phx.gbl...

[Klaus Linke]

"Stefan Blom" <no....@please.xyz> schrieb:

> Well, since the OP uses an outline, she probably wants to keep the
> styles and, also, keep all subordinate paragraphs with their
> "parents".

Yes, right.
Ibby posted a macro to shuffle formatted table rows in the same old thread.
I adapted it below to work with paragraphs.
Select the paragraphs you want to shuffle and start the macro.

And, as Ibby said in that thread, the original text is deleted, so make a backup of your original document first (or remember you can undo almost everything until you close a document).
Regards,

Klaus

Sub IbbysShuffle()
Dim oldDoc As Document
Dim newDoc As Document
Dim myRange As Range
Dim i As Long
Dim counter As Long
Set oldDoc = ActiveDocument
Set myRange = Selection.Range.Duplicate
Set newDoc = Documents.Add
For counter = 1 To myRange.Paragraphs.Count
i = Int(myRange.Paragraphs.Count * Rnd) + 1
newDoc.Paragraphs.Last.Range.FormattedText = _
myRange.Paragraphs(i).Range
myRange.Paragraphs(i).Range.Delete
Next counter
End Sub

[David Sisson]

Nikki Rohrback wrote:
> But that is still time consuming. I'm looking for a way to randomly
scramble
> all of them (sometimes 50 questions and the respective answers) at
one shot.
>

This seems to work on Word's outline. (Word2000)
I assumed four answers per question.
The randomization isn't always effective, but running multiple times
seems to do the trick.

Sub RandomizeAnswers()
'Randomizes multiple choise questions in outline format.
'Case statements from Klaus Linke in a NG message dated Feb 19 2002.
'By David Sisson May 2005

Dim tPara, NumAns, PickValue As Long
Dim A As Integer

tPara = ActiveDocument.Paragraphs.Count
NumAns = 4 'Can be changed to 3, but not tested

For A = tPara To 1 Step -1
With ActiveDocument.Paragraphs(A)

Select Case .Range.ListFormat.ListType
Case wdListNoNumbering
'MsgBox "no numbering"

Case wdListBullet
'MsgBox "Bullet"

Case wdListSimpleNumbering
'MsgBox "Simple numbering"

PickValue = Int((NumAns * Rnd) + 1)

Counter = Counter + 1 'Keeps movement of answers inside Question

Select Case Counter
Case 1
'.Range.Relocate wdRelocateUp

Case 2
.Range.Relocate wdRelocateUp
If PickValue Mod 2 = 0 Then
.Range.Relocate wdRelocateUp
End If
Case 3
.Range.Relocate wdRelocateDown
If Counter >= NumAns Then Counter = 0

Case 4
.Range.Relocate wdRelocateDown
If PickValue Mod 2 = 1 Then
.Range.Relocate wdRelocateDown
End If
If Counter >= NumAns Then Counter = 0
End Select

Case wdListOutlineNumbering
'MsgBox "Outline numbering"
Case wdListListNumOnly
'MsgBox "LISTNUM field"
Case wdListMixedNumbering
'MsgBox "Mixed numbering"
Case Else
'MsgBox "Unknown constant"
End Select
End With
Next A

End Sub

Sub PrintAnswerKey()
'Add hidden text to indicate correct answer and run this sub.
'This way, no matter how the answers get rearranged, you'll
'always be able to print a key.

A = MsgBox("Print Answer Key", vbYesNo, "Select Yes/No")

If A = 6 Then
Options.PrintHiddenText = True
ActiveDocument.PrintOut
Options.PrintHiddenText = False
End If

End Sub