0

私は教師であり、Microsoft Word を使用して学生向けに多肢選択式のテストを数多く作成しています。問題を自動的にシャッフルして、テストの周りに問題をコピー アンド ペーストすることなく、複数のバージョンのテストを使用できるようにする方法はありますか? オンラインで見ると、Steve Yandl が投稿した 1 つの解決策が見つかりました。この解決策では、各質問を表の個別の行に配置した後にマクロを使用していました。彼のマクロを機能させようとしていますが、エラーがあります。私はコーディングについて何も知らないので、行き詰まっています。彼のコードは次のとおりです。

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 に答える