0

我是一名教师，我一直在为使用 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"

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

4

2 回答 2

1

你的文件有桌子吗？

你把子（ShuffleQuestions）放在哪里？

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

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

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

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

因此，解决方案是：

  1. 确保您的子文件在您正在编辑的文档中（而不是文档模板）
  2. 您的文档中有一个表格。

在子 ShuffleQuestions 中也有一些编程错误（例如 Do While intQsLeft = 0 应该类似于 Do While intQsLeft > 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
于 2013-10-03T07:47:59.363 回答
0

对于那些想要随机化文档中所有段落的人。要使其正常工作，请将光标放在文档末尾，不要进行任何选择。

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

结束子

于 2020-06-29T13:15:51.270 回答