Question

我是一名教师，我一直在为使用Microsoft Word的学生进行多项多项选择考试。有没有办法让我自动洗牌问题，这样我就可以有多个版本的测试，而无需在测试中复制和粘贴问题？在线查看我找到了一个由Steve Yandl发布的解决方案，其中在将每个问题放在表格中的单独行之后使用宏。我试图让他的宏工作，但它有和错误。我对编码几乎一无所知，所以我被卡住了。这是他的代码：

Sub ShuffleQuestions()

Dim Tmax As Integer
Dim strCell As String
Dim strQ As Variant
Dim strText As String
Dim I As Integer
Dim Z As Integer
Dim intQsLeft As Integer
Dim rndQ As Integer
Dim Q As Integer
Dim vArray As Variant
Dim strNew As String

Set objDict = CreateObject("Scripting.Dictionary")

Tmax = ThisDocument.Tables(1).Rows.Count

For I = 1 To Tmax
strCell = ThisDocument.Tables(1).Cell(I, 1).Range.Text
strQ = Left(strCell, Len(strCell) - 1)
objDict.Add strQ, strQ
Next I

ReDim arrQs(I - 1)

intQsLeft = I - 2
Z = 0


Do While intQsLeft = 0
Randomize
rndQ = Int((intQsLeft + 1) * Rnd)
intQsLeft = intQsLeft - 1
vArray = objDict.Items
strText = vArray(rndQ)
arrQs(Z) = strText
Z = Z + 1
objDict.Remove strText
Loop

For Q = 1 To Tmax
strNew = arrQs(Q - 1)
strNew = Left(strNew, Len(strNew) - 1)
ThisDocument.Tables(1).Cell(Q, 1).Range.Text = strNew
Next Q


End Sub

我收到的错误消息显示“运行时错误5941所请求的集合成员不存在” 当我选择“调试”按钮时，它会将我带到宏中的代码行“Tmax = ThisDocument.Tables（1）.Rows.Count”

最终我只是想重新排序问题，但如果还有一种方法可以为每个问题重新排序我的多项选择，我会很高兴。

Answer 1

你的文件有桌子吗？

你把子（ShuffleQuestions）放在哪里？

您确定是否已将其添加到文档中，并且未将其添加到文档模板中（可能是正常的）。

如果在运行代码后，出现错误并单击调试，则突出显示ThisDocument.Tables，右键单击突出显示的文本，然后从弹出菜单中选择“添加监视”，您应该可以看到ThisDocument.Tables是否包含任何数据。

我怀疑它会是空的。如果出现以下情况，它将为空：

您尚未在文档中添加表格
您已将sub添加到normal.dot，在这种情况下，ThisDocument将引用普通模板，而不是您实际编辑的文档。

所以，解决方案是：

确保您的子文件位于您正在编辑的文档中（而不是文档模板）
您的文档中有一张表。

在子ShuffleQuestions中也存在一些编程错误（例如，当intQsLeft = 0时，应该像DoQsLeft＆gt; 0那样做。）

以下代码有效（并且更简单）：

Sub ShuffleQuestions()

Dim numberOfRows As Integer
Dim currentRowText As String
Dim I As Integer
Dim doc As Document


Set doc = ActiveDocument

'Find the number of rows in the first table of the document
numberOfRows = doc.Tables(1).Rows.Count
'Initialise (seed) the random number generator
Randomize
'For each row in the table
For I = 1 To numberOfRows
    'Find a new row number (any row in the table)
    newRow = Int(numberOfRows * Rnd + 1)
    'Unless we're not moving to a new row
    If newRow <> I Then
        'Get the current row text
        currentRowText = CleanUp(doc.Tables(1).Cell(I, 1).Range.Text)
        'Overwrite the current row text with the new row text
        doc.Tables(1).Cell(I, 1).Range.Text = CleanUp(doc.Tables(1).Cell(newRow, 1).Range.Text)
        'Put the current row text into the new row
        doc.Tables(1).Cell(newRow, 1).Range.Text = currentRowText
    End If
Next I

End Sub


Function CleanUp(value As String) As String
   'Remove control characters from the end of the string (the cell text has a 'BELL' character and CR at the end)
   While (Len(value) > 0 And Asc(Right(value, 1)) < 32)
        value = Left(value, Len(value) - 1)
   Wend
   CleanUp = value
End Function

Answer 2

对于那些希望将文档中所有段落随机化的人。要使其正常工作，请将光标置于文档的末尾，而无需进行选择。

Sub ran_para()
n = ActiveDocument.Paragraphs.Count
ReDim a(1 To 2, 1 To n)
Randomize
For i = 1 To n
    a(1, i) = Rnd
    a(2, i) = i
Next
For i = 1 To n - 1
    For j = i + 1 To n
        If a(1, j) > a(1, i) Then
            t = a(2, i)
            a(2, i) = a(2, j)
            a(2, j) = t
        End If
    Next
Next
'Documents.Add
For i = 1 To n
    Set p = ActiveDocument.Paragraphs.Add
    p.Range.Text = ActiveDocument.Paragraphs(a(2, i)).Range.Text
Next

结束子

如何随机化Microsoft Word中的列表？

2 个答案: