实现的思路：
导入题库word文件导入到excel–>绑定随机事件选定考题。
word题库导入Excel表的代码如下：

整理题库结构（添加题号，分离答案）
Public Sub numAdd()
Dim rng As Range, RNG1 As Range
With Sheet1
.[b1] = “题号”
.[c1] = “答案”
On Error Resume Next
For Each rng In .Range(“a2:a” & .Cells(Rows.Count, 1).End(xlUp).Row)
'rng = Replace(rng, chr(13), “”)
If qFind(rng) <> “” Then 'And qFind(rng) Like “[a-dA-D√?×Xx]” Then
counter = counter + 1
If qFind(rng) Like “[?√Vv]” Then
rng.Offset(0, 2) = “Y”
ElseIf qFind(rng) Like “[×Xx]” Then
rng.Offset(0, 2) = “N”
ElseIf Asc(qFind(rng)) = 63 Then
rng.Offset(0, 2) = “Y”
Else
rng.Offset(0, 2) = qFind(rng)
End If
rng = counter & ". " & Replace(rng.Value, qFind(rng), “”)
rng.Offset(0, 1) = counter
If rng.Row < .Columns(1).Find(“判断题：”).Row Then
rws = rng.End(xlDown).Row - rng.Row
’ Debug.Print rng & “|” & rws
If rws = 4 Then
For Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))
ct = ct + 1
Select Case ct
Case Is = 1
RNG1 = "A. " & RNG1.Value
Case Is = 2
RNG1 = "B. " & RNG1.Value
Case Is = 3
RNG1 = "C. " & RNG1.Value
Case Is = 4
RNG1 = "D. " & RNG1.Value

                End SelectNextElseIf rws = 5 ThenFor Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))ct = ct + 1Select Case ctCase Is = 1RNG1 = "A. " & RNG1.ValueCase Is = 2RNG1 = "B. " & RNG1.ValueCase Is = 3RNG1 = "C. " & RNG1.ValueCase Is = 4RNG1 = "D. " & RNG1.ValueCase Is = 5RNG1 = "E. " & RNG1.ValueEnd SelectNextElseIf rws = 9 ThenFor Each RNG1 In .Range(.Cells(rng.Row + 1, 1), .Cells(rng.End(xlDown).Row, 1))ct = ct + 1Select Case ctCase Is = 1RNG1 = "A. " & RNG1.ValueCase Is = 2RNG1 = "B. " & RNG1.ValueCase Is = 3RNG1 = "C. " & RNG1.ValueCase Is = 4RNG1 = "D. " & RNG1.ValueCase Is = 5RNG1 = "E. " & RNG1.ValueCase Is = 6RNG1 = "F. " & RNG1.ValueCase Is = 7RNG1 = "G. " & RNG1.ValueCase Is = 8RNG1 = "H. " & RNG1.ValueCase Is = 9RNG1 = "I. " & RNG1.ValueEnd SelectNextEnd IfEnd If
End If
ct = 0

Next
Sheet2.TextBox1.Text = counter
End With
End Sub
设计操作界面

绑定点击操作事件
Private Sub CommandButton1_Click()
On Error Resume Next
Dim qnum As Integer, no As Integer

If Sheet2.OptionButton1.Value Then
selectQNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlUp)
no = WorksheetFunction.RandBetween(1, selectQNum)
no = uniqueGen(no)
Call qSelect(no)
Sheet2.TextBox2.Text = no
[e1] = “已选题号”
Cells(Rows.Count, “e”).End(xlUp).Offset(1, 0) = no
Else
stNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlDown)
endNum = Sheet1.Cells(Rows.Count, 2).End(xlUp)
no = WorksheetFunction.RandBetween(stNum, endNum)
no = uniqueGen(no)
Call qSelect(no)
Sheet2.TextBox2.Text = no
[e1] = “已选题号”
Cells(Rows.Count, “e”).End(xlUp).Offset(1, 0) = no
End If
End Sub

创建非重复题目选择函数
Public Function uniqueGen(no)
On Error Resume Next
selectQNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlUp)
For i = 1 To selectQNum
If Sheet2.OptionButton1.Value = True Then
no = WorksheetFunction.RandBetween(1, selectQNum)
If Sheet2.Columns(“e”).Find(no).Row = “” Then
uniqueGen = no
Exit For
End If
Else
stNum = Sheet1.Columns(1).Find(“判断题：”).Offset(0, 1).End(xlDown)
endNum = Sheet1.Cells(Rows.Count, 2).End(xlUp)
no = WorksheetFunction.RandBetween(stNum, endNum)
If Sheet2.Columns(“e”).Find(no).Row = “” Then
uniqueGen = no
Exit For
End If
End If
Next
End Function
给“查看答案”添加执行程序，代码如下：