Consulting

Page 3 of 3 FirstFirst 1 2 3
Results 41 to 56 of 56

Thread: How to scramble tables in word

  1. #41
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  2. #42
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  3. #43
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    Quote Originally Posted by gmaxey View Post

    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.

  4. #44
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  5. #45
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  6. #46
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
     > 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)
    Last edited by mana; 08-21-2019 at 05:40 AM.

  7. #47
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  8. #48
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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

  9. #49
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  10. #50
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    266
    Location
    This has been an interesting thread!

  11. #51
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    Where is the test generator file or template for this?? I can't find!!!

  12. #52
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    Where is the test generator file for this Test Bank 250.docm??

    Quote Originally Posted by gmaxey View Post
    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

  13. #53
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    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

  14. #54
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    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!!!

    Quote Originally Posted by gmaxey View Post
    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

  15. #55
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    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.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  16. #56
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    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???

    Quote Originally Posted by gmaxey View Post
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •