基于Word图文试题库系统（二）

下面介绍一些我今年暑假编的一套题库系统，是在word上用VBA编的题库系统。所有的操作在Word上完成！主要的功能有题库的录入，题库的统计，随机抽取题库试题，试题难度和内容的安排，试卷的排版！想知道具体的东西，可以到我发布的资源下载。下面把我的代码公布：

    下面把试卷A，试卷B，答案A，答案B文档的代码公布：

 ‘===========================================================================

’试卷A的代码：
’thisdocument中的代码：
Private Sub Document_Open()
Call ActivateOrOpenDocument("答案A.doc")
End Sub
Private Sub Document_Close()
Documents("试卷A.doc").Save
Call ActivateOrCloseDocument("答案A.doc")

End Sub

Sub ActivateOrOpenDocument(lb)
    Dim doc As Document
    Dim docFound As Boolean

    For Each doc In Documents
        If InStr(1, doc.Name, lb, 1) Then
            doc.Activate
            docFound = True
            Exit For
        Else
            docFound = False
        End If
    Next doc
    If docFound = False Then Documents.Open FileName:=lb
End Sub
Sub ActivateOrCloseDocument(lb)
On Error Resume Next
    Dim doc As Document
    Dim docFound As Boolean
    For Each doc In Documents
        If InStr(1, doc.Name, lb, 1) Then
            doc.Activate
            docFound = True
            Exit For
        Else
            docFound = False
        End If
    Next doc
    If docFound = True Then ActiveDocument.Close
End Sub
‘模块中的代码：
'"查看原体"子程序的作用就是根据“试卷”文档中当前行的试题编号，到“题库”文档中查找和定位指定的试题，代码如下：
Sub 查看原体()
    Selection.HomeKey Unit:=wdLine   '光标到行首
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend  '选中当前行
    tt = Left(Selection.Text, 1)   '取出最左边1个字符
    If tt <> "`" Then Exit Sub     '不是题标行，退出子程序
    xh = Left(Selection.Text, 5) '取出题编号
    Windows("题库.doc").Activate
    Selection.HomeKey Unit:=wdStory  '光标到头文件
    Selection.Find.Text = xh    '查找指定序号的试题
    Selection.Find.Execute      '执行查找
    Selection.EndKey Unit:=wdLine   '光标移到行末尾
End Sub
'=========================================================================================================================
'更换试题子程序的作用是用“题库”中相同参数的其他试题替换“试卷”文档的当前试题，同时替换“答案”文档对应试题的答案
'==========================================================================================================================
Sub 更换试题()
    Selection.HomeKey Unit:=wdLine   '光标到行首
    Selection.MoveRight Unit:=wdCharacter, Count:=10, Extend:=wdExtend      '选中10个字符
    tt = Left(Selection.Text, 1)        '取出最左边一个字符
    If tt <> "`" Then Exit Sub
    tt = Right(Selection.Text, 4)       '取出试题参数
    t_no = Mid(Selection.Text, 2, 4)    '取出试题编号
    Selection.HomeKey Unit:=wdLine
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    t_xh = Selection.Text               '取出试题序号
    Selection.MoveDown Unit:=wdLine<