How to scramble tables in word

**gmaxey** · 08-19-2019, 01:41 PM

mana,

I have been tinkering with your last approach. Please excuse my variable changes (it is just my style). I found what I considered a minor shortcoming and have tried to address it. In my sample test bank there are 13 sections with 10 questions in section 1 and 20 each in sections 2-13.

When I created and exam with 130 questions, ALL questions were used from section 1. I thought it would be an enhancement to "weight" the questions taken from search section.

I've done that by adding an additional dictionary oDicReserve. You might be able to do it using one of the existing dictionaries.

Thanks!!

Sub CreateTestAdv4()
Dim oDocBank As Document
Dim oBankTbls As Tables, oTbl As Table
Dim bEnough As Boolean
Dim oAllList As Object, oRanNumGen As Object
Dim oDicSec As Object, oDicQue As Object, oDicReserve As Object, oDicExtract As Object
Dim lngQuestions As Long
Dim lngSec As Long, lngSecCount As Long
Dim lngIndex As Long, lngTable As Long
Dim oRng As Range, oRngInsert As Range
Dim oFld As Field
Dim dblWt As Double, dblSecWt As Double, lngReserve As Long
Dim lngRanNum As Long, varKey

  'Call routine to clear any existing questions.
  ClearQuestions
  'Open the test bank document.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank 250.docm", , , False, , , , , , , , False)
  'Get user defined number of questions.
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  Set oBankTbls = oDocBank.Tables
  If oBankTbls.Count >= lngQuestions Then bEnough = True
  dblWt = lngQuestions / oBankTbls.Count
  Set oAllList = CreateObject("system.collections.sortedlist")
  Set oRanNumGen = CreateObject("system.random")
  Set oDicSec = CreateObject("scripting.dictionary")
  Set oDicQue = CreateObject("scripting.dictionary")
  Set oDicReserve = CreateObject("scripting.dictionary")
  Set oDicExtract = CreateObject("scripting.dictionary")
  lngSecCount = oDocBank.Sections.Count

  If bEnough Then
    'Create a randomized list of the entire bank table collection.
    For lngSec = 1 To lngSecCount
      'Some sections may have fewer questions than others. Determine the number of questions that should be reserved so all question is
      'one section aren't used.
      dblSecWt = dblWt * oDocBank.Sections(lngSec).Range.Tables.Count
      lngReserve = oDocBank.Sections(lngSec).Range.Tables.Count - Int(dblSecWt)
      For Each oTbl In oDocBank.Sections(lngSec).Range.Tables
        lngTable = lngTable + 1
        Do
          lngRanNum = oRanNumGen.Next()
          If Not oAllList.contains(lngRanNum) Then Exit Do
        Loop
        oAllList(lngRanNum) = Array(lngTable, lngSec)
        oDicReserve(lngSec) = lngReserve
        'Note - resulting list is sorted on the random keys.
      Next oTbl 'lngIndex
    Next lngSec
    'Create a queue (or list of table indexes) for each section
    For lngIndex = 0 To oAllList.Count - 1
      lngTable = oAllList.GetByIndex(lngIndex)(0) 'Returns the table index number
      lngSec = oAllList.GetByIndex(lngIndex)(1) 'Returns the document section number
      If Not oDicSec.Exists(lngSec) Then
        Set oDicSec(lngSec) = CreateObject("system.collections.queue")
      End If
      'Add section table index to queue.
      oDicSec(lngSec).enqueue lngTable
    Next
    'Create a clone dictionary
    For Each varKey In oDicSec.Keys
      Set oDicQue(varKey) = oDicSec(varKey).Clone
    Next
    Do
      For Each varKey In oDicSec.Keys
        If oDicQue(varKey).Count >= oDicReserve.Item(varKey) And oDicQue(varKey).Count > 0 Then
          'Note: oDicQue(varKey).dequeue returns the index number of a test bank table.
          oDicExtract(oDicQue(varKey).dequeue) = Empty
        End If
        'The keys in oDicExtract define a list of random non-repeating table index numbers.
        If oDicExtract.Count = lngQuestions Then Exit Do
      Next
    Loop
    Application.ScreenUpdating = False
    For lngSec = 1 To lngSecCount
      Do
        If oDicSec(lngSec).Count = 0 Then Exit Do
        lngIndex = oDicSec(lngSec).dequeue
        If Not oDicExtract.Exists(lngIndex) Then Exit Do
        Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
        Set oRng = oBankTbls(lngIndex).Range
        With oRngInsert
          .FormattedText = oRng.FormattedText
          .Collapse wdCollapseEnd
          .InsertBefore vbCr
          .Collapse wdCollapseEnd
        End With
        ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
      Loop
    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 the test bank document to create the test define."
  End If
lbl_Exit:
  oDocBank.Close wdDoNotSaveChanges
  Set oAllList = Nothing: Set oRanNumGen = Nothing
  Set oDicSec = Nothing: Set oDicQue = Nothing: Set oDicReserve = Nothing: Set oDicExtract = Nothing
  Set oDocBank = Nothing: Set oBankTbls = Nothing: Set oTbl = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
End Sub

**mana** · 08-20-2019, 03:11 AM

Thanks. It became very easy to understand.
I think it is better to change like below.

lngReserve = oDocBank.Sections(lngSec).Range.Tables.Count - Int(dblSecWt)
oDicReserve(lngSec) = lngReserve        '<-----------moved here
For Each oTbl In oDocBank.Sections(lngSec).Range.Tables

**mana** · 08-20-2019, 03:37 AM

Originally Posted by gmaxey

I've done that by adding an additional dictionary oDicReserve. You might be able to do it using one of the existing dictionaries.

It's possible.
But I think there is no advantage
Probably such code is poor readability.

**mana** · 08-20-2019, 05:50 AM

Like this

   'Create a clone dictionary
    For Each varKey In oDicSec.Keys
      Set oDicQue(varKey) = oDicSec(varKey).Clone
      dblSecWt = dblWt * oDicSec(varKey).Count
      lngReserve = oDicSec(varKey).Count - Int(dblSecWt)
      oDicQue(varKey).enqueue lngReserve
    Next
    Do
      For Each varKey In oDicSec.Keys
        With oDicQue(varKey)
            If .Count > .toarray()(.Count - 1) And .Count > 1 Then
              'Note: oDicQue(varKey).dequeue returns the index number of a test bank table.
              oDicExtract(.dequeue) = Empty
            End If
        End With

**gmaxey** · 08-20-2019, 08:07 AM

mana,

I like that! I've made a few more tweaks and comments (more to help me understand) what is going on. One thing I noticed with your suggestion above was it erred if I tried to create a test using ALL questions in the bank. With the following, I was able to create a test of 250 questions (using every question in every section), a test of 13 questions (1 question from each sections) and a dozen or so variations in between e.g., 25 gives 1 question from section 1 and 2 from the others.

Sub CreateTestAdv4()
Dim oDocBank As Document
Dim oBankTbls As Tables, oTbl As Table
Dim bEnough As Boolean
Dim oAllList As Object, oRanNumGen As Object
Dim oDicSec As Object, oDicQue As Object, oDicExtract As Object
Dim lngQuestions As Long
Dim lngSec As Long, lngSecCount As Long
Dim lngIndex As Long, lngTable As Long
Dim oRng As Range, oRngInsert As Range
Dim oFld As Field
Dim dblWt As Double, dblSecWt As Double, lngReserve As Long
Dim lngRanNum As Long, varKey

  'Call routine to clear any existing questions.
  ClearQuestions
  'Open the test bank document.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank 250.docm", , , False, , , , , , , , False)
  'Get user defined number of questions.
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  Set oBankTbls = oDocBank.Tables
  If oBankTbls.Count >= lngQuestions Then bEnough = True
  
  Set oAllList = CreateObject("system.collections.sortedlist")
  Set oRanNumGen = CreateObject("system.random")
  Set oDicSec = CreateObject("scripting.dictionary")
  Set oDicQue = CreateObject("scripting.dictionary")
  Set oDicExtract = CreateObject("scripting.dictionary")
  lngSecCount = oDocBank.Sections.Count
  'Calculate the percentage of questions used.
  dblWt = lngQuestions / oBankTbls.Count

  If bEnough Then
    'Create a randomized list of the entire bank table collection.
    For lngSec = 1 To lngSecCount
      For Each oTbl In oDocBank.Sections(lngSec).Range.Tables
        lngTable = lngTable + 1
        Do
          lngRanNum = oRanNumGen.Next()
          If Not oAllList.contains(lngRanNum) Then Exit Do
        Loop
        oAllList(lngRanNum) = Array(lngTable, lngSec)
        'Note - resulting list is sorted on the random keys.
      Next oTbl
      'Create queue for questions in each section
      Set oDicSec(lngSec) = CreateObject("system.collections.queue")
    Next lngSec
    
    'Queue the randomly indexed questions in each section.
    For lngIndex = 0 To oAllList.Count - 1
      lngTable = oAllList.getByIndex(lngIndex)(0) 'Returns the table index number
      lngSec = oAllList.getByIndex(lngIndex)(1) 'Returns the document section number
      'Add table index to its section queue.
      oDicSec(lngSec).enqueue lngTable
    Next
    
    'Clone the oDicSec dictionary and define reserve.
    For Each varKey In oDicSec.Keys
      Set oDicQue(varKey) = oDicSec(varKey).Clone
      'Some sections may have fewer questions than others.
      'Calculate the percentage of questions to use from section.
      dblSecWt = dblWt * oDicSec(varKey).Count
      'Define the number of question to reserve (not use) from the section. This avoids using all questions from a section with fewer questions.
      lngReserve = oDicSec(varKey).Count - Int(dblSecWt)
      'Save lngReserve as last item in queue
      oDicQue(varKey).enqueue lngReserve
    Next
    
    'Extract user defined number of questions from the cueued section questions.
    Do
      For Each varKey In oDicSec.Keys
        With oDicQue(varKey)
          'Ensure there at least one table index remaining in queue and number in queue is  => than calculated reserve
           Select Case True
            Case lngQuestions < oAllList.Count And lngQuestions > lngSecCount
              If .Count > 1 And .Count > .toArray()(.Count - 1) + 1 Then
                'Notes:
                'If Count = 1 the only data left in queue is the stored reserve
                '.toArray()(.Count - 1) returns the stored reserve.
                'oDicQue(varKey).dequeue returns the index number of a test bank table.
                oDicExtract(.dequeue) = Empty
              End If
            Case Else
              'Case where all questions are used or question count =< section count.
              If .Count > 1 And .Count > .toArray()(.Count - 1) Then
                oDicExtract(.dequeue) = Empty
              End If
          End Select
        End With
        'The keys in oDicExtract define a list of random non-repeating table index numbers.
        If oDicExtract.Count = lngQuestions Then Exit Do
      Next
    Loop
    'Build the test from extracted questions.
    Application.ScreenUpdating = False
    For lngSec = 1 To lngSecCount
      Do
        If oDicSec(lngSec).Count = 0 Then Exit Do
        'Start dequeing random index numbers from the section queue.
        lngIndex = oDicSec(lngSec).dequeue
        'Only process table index numbers defined in the extracted queue.
        If Not oDicExtract.Exists(lngIndex) Then Exit Do
        Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
        Set oRng = oBankTbls(lngIndex).Range
        With oRngInsert
          .FormattedText = oRng.FormattedText
          .Collapse wdCollapseEnd
          .InsertBefore vbCr
          .Collapse wdCollapseEnd
        End With
        ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
      Loop
    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 the test bank document to create the test define."
  End If
lbl_Exit:
  oDocBank.Close wdDoNotSaveChanges
  Set oAllList = Nothing: Set oRanNumGen = Nothing
  Set oDicSec = Nothing: Set oDicQue = Nothing: Set oDicExtract = Nothing
  Set oDocBank = Nothing: Set oBankTbls = Nothing: Set oTbl = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
End Sub

**mana** · 08-21-2019, 02:57 AM

　> Case lngQuestions < oAllList.Count And lngQuestions > lngSecCount
　> Case Else
　> 'Case where all questions are used or question count =< section count.

When lngReserve was calculated by the following formula in all cases,
are there any problems?

lngReserve = Int(oDicSec(varKey).Count - dblSecWt)

**gmaxey** · 08-21-2019, 03:33 AM

mana,

That helped.

Sub CreateTestAdv5()
Dim oDocBank As Document
Dim oBankTbls As Tables, oTbl As Table
Dim bEnough As Boolean
Dim oAllList As Object, oRanNumGen As Object
Dim oDicSec As Object, oDicQue As Object, oDicExtract As Object
Dim lngQuestions As Long
Dim lngSec As Long, lngSecCount As Long
Dim lngIndex As Long, lngTable As Long
Dim oRng As Range, oRngInsert As Range
Dim oFld As Field
Dim dblWt As Double, dblSecWt As Double, lngReserve As Long
Dim lngRanNum As Long, varKey

  'Call routine to clear any existing questions.
  ClearQuestions
  'Open the test bank document.
  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank 250.docm", , , False, , , , , , , , False)
  'Get user defined number of questions.
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  Set oBankTbls = oDocBank.Tables
  If oBankTbls.Count >= lngQuestions Then bEnough = True
  
  Set oAllList = CreateObject("system.collections.sortedlist")
  Set oRanNumGen = CreateObject("system.random")
  Set oDicSec = CreateObject("scripting.dictionary")
  Set oDicQue = CreateObject("scripting.dictionary")
  Set oDicExtract = CreateObject("scripting.dictionary")
  lngSecCount = oDocBank.Sections.Count
  'Calculate the percentage of questions used.
  dblWt = lngQuestions / oBankTbls.Count

  If bEnough Then
    'Create a randomized list of the entire bank table collection.
    For lngSec = 1 To lngSecCount
      For Each oTbl In oDocBank.Sections(lngSec).Range.Tables
        lngTable = lngTable + 1
        Do
          lngRanNum = oRanNumGen.Next()
          If Not oAllList.contains(lngRanNum) Then Exit Do
        Loop
        oAllList(lngRanNum) = Array(lngTable, lngSec)
        'Note - resulting list is sorted on the random keys.
      Next oTbl
      'Create queue for questions in each section
      Set oDicSec(lngSec) = CreateObject("system.collections.queue")
    Next lngSec
    
    'Queue the randomly indexed questions in each section.
    For lngIndex = 0 To oAllList.Count - 1
      lngTable = oAllList.getByIndex(lngIndex)(0) 'Returns the table index number
      lngSec = oAllList.getByIndex(lngIndex)(1) 'Returns the document section number
      'Add table index to its section queue.
      oDicSec(lngSec).enqueue lngTable
    Next
    
    'Clone the oDicSec dictionary and define reserve.
    For Each varKey In oDicSec.Keys
      Set oDicQue(varKey) = oDicSec(varKey).Clone
      'Some sections may have fewer questions than others.
      'Calculate the percentage of questions to use from section.
      dblSecWt = dblWt * oDicSec(varKey).Count
      'Define the number of question to reserve (not use) from the section. This avoids using all questions from a section with fewer questions.
      lngReserve = Int(oDicSec(varKey).Count - dblSecWt)
      'Save lngReserve as last item in queue
      oDicQue(varKey).enqueue lngReserve
    Next
    
    'Extract user defined number of questions from the cueued section questions.
    Do
      For Each varKey In oDicSec.Keys
        With oDicQue(varKey)
          'Ensure there at least one item remaining in queue (the stored reserve) and number of table index numbers in queue is  > than calculated reserve
          If .Count > 1 And .Count > .toArray()(.Count - 1) + 1 Then
            'Notes:
            'If Count = 1 the only data left in queue is the stored reserve
            '.toArray()(.Count - 1) returns the stored reserve.
            'oDicQue(varKey).dequeue returns the index number of a test bank table.
            oDicExtract(.dequeue) = Empty
          End If
        End With
        'The keys in oDicExtract define a list of random non-repeating table index numbers.
        If oDicExtract.Count = lngQuestions Then Exit Do
      Next
    Loop
    'Build the test from extracted questions.
    Application.ScreenUpdating = False
    For lngSec = 1 To lngSecCount
      Do
        If oDicSec(lngSec).Count = 0 Then Exit Do
        'Start dequeing random index numbers from the section queue.
        lngIndex = oDicSec(lngSec).dequeue
        'Only process table index numbers defined in the extracted queue.
        If Not oDicExtract.Exists(lngIndex) Then Exit Do
        Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
        Set oRng = oBankTbls(lngIndex).Range
        With oRngInsert
          .FormattedText = oRng.FormattedText
          .Collapse wdCollapseEnd
          .InsertBefore vbCr
          .Collapse wdCollapseEnd
        End With
        ActiveDocument.Bookmarks.Add "QuestionAnchor", oRngInsert
      Loop
    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 the test bank document to create the test define."
  End If
lbl_Exit:
  oDocBank.Close wdDoNotSaveChanges
  Set oAllList = Nothing: Set oRanNumGen = Nothing
  Set oDicSec = Nothing: Set oDicQue = Nothing: Set oDicExtract = Nothing
  Set oDocBank = Nothing: Set oBankTbls = Nothing: Set oTbl = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
End Sub
Sub ClearQuestions()
Dim lngIndex As Long
Dim oRng As Range
 For lngIndex = ActiveDocument.Tables.Count To 1 Step -1
   Set oRng = ActiveDocument.Tables(lngIndex).Range.Paragraphs(1).Range
   ActiveDocument.Tables(lngIndex).Delete
   oRng.Delete
Next
End Sub

**Artik** · 08-24-2019, 04:24 PM

I would like to explain the Next_2 method.
Because my English is perfect like Google Translator

please refer to the following page: https://kaimi.io/en/2012/04/wsh/
You can find some explanation from the sentence: "What else do you have to know when using .NET assemblies?"

Greg asked for explanation "dic (n) = Empty". This is a simpler record of the structure shown in the code:

Sub BBB()

    Dim dic         As Object
    Dim rn          As Object
    Dim n
    Dim varKeys
    Dim varItems


    Set rn = CreateObject("system.random")
    Set dic = CreateObject("scripting.dictionary")


    Do
        n = rn.next_2(1, 11)
        'dic(n) = Empty
        If Not dic.exists(n) Then
            dic.Add n, Empty
        End If
        
        If dic.Count = 10 Then Exit Do
    Loop


    varKeys = dic.keys
    varItems = dic.items


    Stop
End Sub

Artik

**gmaxey** · 08-24-2019, 04:40 PM

Artik,

Thanks. My puzzlement was more like what was the purpose of "Empty" The conclusion I came to was mana used Empty not for some real intended purpose but that it really didn't matter what he used. I can replace Empty (which okay might preserve some resources) with:

        If Not dic.Exists(n) Then
            dic.Add n, "Bob' your uncle"
        End If

... and the process works just as well.

Best Regards,
Greg Maxey

Keep away from people who try to belittle your ambitions. Small people always do that, but the really great make you feel that you, too, can become great.
~ Mark Twain

**Kilroy** · 08-24-2019, 07:46 PM

This has been an interesting thread!

**sajitsir** · 04-24-2023, 06:41 PM

Where is the test generator file or template for this?? I can't find!!!

**sajitsir** · 04-24-2023, 06:43 PM

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

Originally Posted by gmaxey

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

Attachment 24825

**Artik** · 04-25-2023, 01:17 AM

In post #22, just below the code is a link to the document.
You can also see it in the quote, under the code, but under the renamed Attachment 24825.

Artik

**sajitsir** · 04-27-2023, 07:00 AM

I am finding the files and codes pretty interesting and fun.

Now my query is -

How do I make it prepare 100 questions by default (as soon as we run the macro) without having to input in the input box, or some way of bypassing the inputbox.

file for macro.png

Much thanks in advance!!!

Originally Posted by gmaxey

Kilroy,

Yes. It was interesting. In fact, I've played around with the concept a little and decided to start with Test Bank.docm file containing 500 (or any number of questions) and and a Test Generator template with code to generate a test with a user defined number of questions drawn randomly from the test bank.

Here is the code (for simplicity, the code required the Test Bank.docm and Test Generator.dotm files to be located in same folder).

Maybe mana will come back showing how to do the same thing with the system.random. I can't find any information for working with it to say return 100 random out of a possible 500.

Option Explicit

Sub CreateTest()
Dim oDocBank As Document
Dim oBankTbls As Tables
Dim oRng As Range, oRngInsert As Range
Dim lngCount As Long, lngIndex As Long, lngQuestions As Long
Dim varRanNums
Dim oFld As Field

  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
  Set oBankTbls = oDocBank.Tables
  Application.ScreenUpdating = False
  lngCount = oBankTbls.Count
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  varRanNums = fcnRandomNonRepeatingNumberGenerator(1, lngCount, lngQuestions)
  Application.ScreenUpdating = False
  For lngIndex = 1 To UBound(varRanNums)
    Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
    Set oRng = oBankTbls(varRanNums(lngIndex)).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
    If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
  Next oFld
  ActiveDocument.Fields.Update
  oDocBank.Close wdDoNotSaveChanges
lbl_Exit:
  Set oDocBank = Nothing: Set oBankTbls = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
  Exit Sub
End Sub


Function fcnRandomNonRepeatingNumberGenerator(LowerNumber As Long, UpperNumber As Long, _
                                              NumRange As Long) As Variant
Dim lngNumbers As Long, lngRandom As Long, lngTemp As Long
ReDim varNumbers(LowerNumber To UpperNumber) As Variant
Dim varRandomNumbers() As Variant
     
  For lngNumbers = LowerNumber To UpperNumber
    varNumbers(lngNumbers) = lngNumbers
  Next lngNumbers
  Randomize
  For lngNumbers = 1 To NumRange
    lngRandom = Int(Rnd() * (UpperNumber - LowerNumber + 1 - (lngNumbers - 1))) + (LowerNumber + (lngNumbers - 1))
    lngTemp = varNumbers(lngRandom)
    varNumbers(lngRandom) = varNumbers(LowerNumber + lngNumbers - 1)
    varNumbers(LowerNumber + lngNumbers - 1) = lngTemp
  Next lngNumbers
  ReDim Preserve varNumbers(LowerNumber To LowerNumber + NumRange - 1)
  ReDim varRandomNumbers(1 To NumRange)
  For lngNumbers = 1 To NumRange
    varRandomNumbers(lngNumbers) = varNumbers(LBound(varNumbers) + lngNumbers - 1)
  Next lngNumbers
  fcnRandomNonRepeatingNumberGenerator = varRandomNumbers
lbl_Exit:
  Exit Function
End Function

Sub ClearQuestions()
Dim lngIndex As Long
Dim oRng As Range
 For lngIndex = ActiveDocument.Tables.Count To 1 Step -1
   Set oRng = ActiveDocument.Tables(lngIndex).Range.Paragraphs(1).Range
   ActiveDocument.Tables(lngIndex).Delete
   oRng.Delete
Next
End Sub

**Aussiebear** · 04-27-2023, 11:40 AM

My guess from reading the code would be in this line

Set oDocBank = Documents.Open(ThisDocument.Path & "\ Test Bank.Docm", , , False, , , , , , , , False)

is the link, so try changing the name Test Bank.Docm to the name of your document.

**sajitsir** · 04-28-2023, 09:49 AM

May be I didn't put it in a proper way. How can I just get 100 questions without the appearance of the input box???

file for macro.png

This will make the process quick. If I need to change it, say to 50, I will then change in the code itself. Any help???

Originally Posted by gmaxey

Kilroy,

Yes. It was interesting. In fact, I've played around with the concept a little and decided to start with Test Bank.docm file containing 500 (or any number of questions) and and a Test Generator template with code to generate a test with a user defined number of questions drawn randomly from the test bank.

Here is the code (for simplicity, the code required the Test Bank.docm and Test Generator.dotm files to be located in same folder).

Maybe mana will come back showing how to do the same thing with the system.random. I can't find any information for working with it to say return 100 random out of a possible 500.

Option Explicit

Sub CreateTest()
Dim oDocBank As Document
Dim oBankTbls As Tables
Dim oRng As Range, oRngInsert As Range
Dim lngCount As Long, lngIndex As Long, lngQuestions As Long
Dim varRanNums
Dim oFld As Field

  Set oDocBank = Documents.Open(ThisDocument.Path & "\Test Bank.docm", , , False, , , , , , , , False)
  Set oBankTbls = oDocBank.Tables
  Application.ScreenUpdating = False
  lngCount = oBankTbls.Count
  lngQuestions = CLng(InputBox("Enter the number of test questions", "NUMBER OF QUESTIONS", "100"))
  varRanNums = fcnRandomNonRepeatingNumberGenerator(1, lngCount, lngQuestions)
  Application.ScreenUpdating = False
  For lngIndex = 1 To UBound(varRanNums)
    Set oRngInsert = ActiveDocument.Bookmarks("QuestionAnchor").Range
    Set oRng = oBankTbls(varRanNums(lngIndex)).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
    If InStr(oFld.Code, "Bank") > 0 Then oFld.Unlink
  Next oFld
  ActiveDocument.Fields.Update
  oDocBank.Close wdDoNotSaveChanges
lbl_Exit:
  Set oDocBank = Nothing: Set oBankTbls = Nothing
  Set oRng = Nothing: Set oRngInsert = Nothing: Set oFld = Nothing
  Exit Sub
End Sub


Function fcnRandomNonRepeatingNumberGenerator(LowerNumber As Long, UpperNumber As Long, _
                                              NumRange As Long) As Variant
Dim lngNumbers As Long, lngRandom As Long, lngTemp As Long
ReDim varNumbers(LowerNumber To UpperNumber) As Variant
Dim varRandomNumbers() As Variant
     
  For lngNumbers = LowerNumber To UpperNumber
    varNumbers(lngNumbers) = lngNumbers
  Next lngNumbers
  Randomize
  For lngNumbers = 1 To NumRange
    lngRandom = Int(Rnd() * (UpperNumber - LowerNumber + 1 - (lngNumbers - 1))) + (LowerNumber + (lngNumbers - 1))
    lngTemp = varNumbers(lngRandom)
    varNumbers(lngRandom) = varNumbers(LowerNumber + lngNumbers - 1)
    varNumbers(LowerNumber + lngNumbers - 1) = lngTemp
  Next lngNumbers
  ReDim Preserve varNumbers(LowerNumber To LowerNumber + NumRange - 1)
  ReDim varRandomNumbers(1 To NumRange)
  For lngNumbers = 1 To NumRange
    varRandomNumbers(lngNumbers) = varNumbers(LBound(varNumbers) + lngNumbers - 1)
  Next lngNumbers
  fcnRandomNonRepeatingNumberGenerator = varRandomNumbers
lbl_Exit:
  Exit Function
End Function

Sub ClearQuestions()
Dim lngIndex As Long
Dim oRng As Range
 For lngIndex = ActiveDocument.Tables.Count To 1 Step -1
   Set oRng = ActiveDocument.Tables(lngIndex).Range.Paragraphs(1).Range
   ActiveDocument.Tables(lngIndex).Delete
   oRng.Delete
Next
End Sub

Thread: How to scramble tables in word

Thread Tools

Display

Tags for this Thread

Posting Permissions