How to scramble tables in word

[sajitsir]

Where is the test generator file for this Test Bank 250.docm??

Kilroy,

Hmm. I created a test bank document (attached) with 250 questions (twenty in sections 1-11 and ten in section 12). Ran the code posted previous and tested with 60, 63, 70 and 73 and all ran fine.

However, I have adjusted the code to address a section with insufficient tables.

Sub CreateTestAdv()
Dim oDocBank As Document
Dim oBankTbls As Tables
Dim oDic As Object, oRanNumGen As Object
Dim oRng As Range, oRngInsert As Range
Dim lngIndex As Long, lngQuestions As Long
Dim oFld As Field
Dim lngSec As Long, lngLow As Long, lngHigh As Long
Dim lngPerBank As Long, lngLastBank As Long
Dim bEnough As Boolean
  'Open the test bank document. The test bank document consists of five sections with 100 questions defined in 100 tables per section.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank 250.docm", , , False, , , , , , , , False)
  'Iniitalize a dictionary and random number generator object.
  Set oDic = CreateObject("scripting.dictionary")
  Set oRanNumGen = CreateObject("system.random")
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  If lngQuestions / oDocBank.Sections.Count - Int(lngQuestions / oDocBank.Sections.Count) > 0.3 Then
    lngPerBank = (lngQuestions \ oDocBank.Sections.Count) + 1
  Else
    lngPerBank = lngQuestions \ oDocBank.Sections.Count
  End If
  lngLastBank = lngQuestions - (lngPerBank * (oDocBank.Sections.Count - 1))
  bEnough = True
  For lngSect = 1 To oDocBank.Sections.Count - 1
    If oDocBank.Sections(lngSec).Range.Tables.Count < lngPerBank Then
      bEnough = False
      Exit For
    End If
  Next lngSec
  If oDocBank.Sections(oDocBank.Sections.Count).Range.Tables.Count > lngLastBank Then
    bEnough = False
  End If
  If bEnough Then
    For lngSec = 1 To oDocBank.Sections.Count
      Set oBankTbls = oDocBank.Sections(lngSec).Range.Tables
      Set oRng = oDocBank.Range
      oRng.End = oBankTbls.Item(1).Range.Start
      lngLow = oRng.Tables.Count
      If lngLow > 1 Then lngLow = lngLow + 1
      Set oRng = oDocBank.Range
      oRng.End = oBankTbls.Item(oBankTbls.Count).Range.End
      lngHigh = oRng.Tables.Count
      Do
        lngIndex = oRanNumGen.next_2(lngLow, lngHigh)
        oDic(lngIndex) = Empty
        If lngSec < oDocBank.Sections.Count Then
          If oDic.Count = lngPerBank * lngSec Then Exit Do
        Else
          If oDic.Count = lngQuestions Then Exit Do
        End If
      Loop
    Next lngSec
    Application.ScreenUpdating = False
    Set oBankTbls = oDocBank.Tables
    For lngIndex = 1 To oDic.Count
      Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
      Set oRng = oBankTbls(oDic.keys()(lngIndex - 1)).Range
      With oRngInsert
        .FormattedText = oRng.FormattedText
        .Collapse wdCollapseEnd
        .InsertBefore vbCr
        .Collapse wdCollapseEnd
      End With
      ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
    Next
    Application.ScreenUpdating = True
    For Each oFld In ActiveDocument.Fields
      'Unlink the sequention question bank number field.
      If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
    Next oFld
    'Update the sequential question number field.
    ActiveDocument.Fields.Update
  Else
    MsgBox "There are not enough questions in one or more sections of the test bank document to create the test define."
  End If
  oDocBank.Close wdDoNotSaveChanges
lbl_Exit:
  Set oDic = Nothing: Set oRanNumGen = Nothing
  Set oDocBank = Nothing: Set oBankTbls = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
  Exit Sub
End Sub

Test Bank 250.docm