frmprinttest.frm

这是我们公司的题库管理系统

VERSION 5.00
Begin VB.Form frmTestPrint 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "试卷打印"
   ClientHeight    =   3195
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton bPrintAnswer 
      Caption         =   "打印评分标准"
      Height          =   375
      Left            =   4560
      TabIndex        =   4
      Top             =   600
      Width           =   1335
   End
   Begin VB.ListBox List1 
      Height          =   2040
      Left            =   360
      TabIndex        =   3
      Top             =   720
      Width           =   3975
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   4560
      TabIndex        =   1
      Top             =   1320
      Width           =   1335
   End
   Begin VB.CommandButton bPrintTest 
      Caption         =   "打印试卷"
      Height          =   375
      Left            =   4560
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请在列表中选择需要打印的试卷："
      Height          =   180
      Left            =   360
      TabIndex        =   2
      Top             =   360
      Width           =   2700
   End
End
Attribute VB_Name = "frmTestPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim testId As Integer
Dim testName As String
'Dim oWord As Word.Application

Private Sub bPrintAnswer_Click()
    If List1.Text <> "" Then
        testId = List1.ItemData(List1.ListIndex)
        testName = List1.List(List1.ListIndex)
        exportAnswerToDocument
    End If
End Sub

Private Sub bPrintTest_Click()
    If List1.Text <> "" Then
        testId = List1.ItemData(List1.ListIndex)
        testName = List1.List(List1.ListIndex)
        exportTestToDocument
    End If
End Sub

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    sSQL = "select * from TEST where CATEGORY_ID = " & categoryId & " and STATUS = '已审' Order by TEST_ID"

    ' 打开连接
    Set cnn = New Connection
    cnn.Open sConnect

    ' 使用提供的集合创建 recordset
    Set rs = New Recordset
    rs.CursorLocation = adUseClient
    rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly
    
    loadList
    
    'Set oWord = New Word.Application
    'oWord.Visible = True
    
    rs.Close
End Sub

Private Sub Form_Terminate()
On Error Resume Next
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not cnn Is Nothing Then
        cnn.Close
        Set cnn = Nothing
    End If
    'Set oWord = Nothing
End Sub

Private Sub loadList()
    Dim i As Integer
    For i = 1 To rs.RecordCount
        List1.AddItem rs!Name
        List1.ItemData(List1.NewIndex) = rs!TEST_ID
        rs.MoveNext
    Next i
End Sub

Private Sub exportTestToDocument()
    Screen.MousePointer = vbHourglass
    
    If categoryId = 1 Then
        testGonggong
    ElseIf categoryId = 2 Then
        testGonggong
    ElseIf categoryId = 3 Then
        testMianshi
    End If
    
    Screen.MousePointer = vbDefault
End Sub

Private Sub exportAnswerToDocument()
    Screen.MousePointer = vbHourglass
    
    If categoryId = 1 Then
        answerGonggong
    ElseIf categoryId = 2 Then
        answerGonggong
    ElseIf categoryId = 3 Then
        answerMianshi
    End If
    
    Screen.MousePointer = vbDefault
End Sub

Private Sub testMianshi()
    Screen.MousePointer = vbHourglass
    
    Dim oWord As Word.Application
    Dim myCell As Word.Cell
    Dim i As Integer
    
    Set oWord = New Word.Application
    oWord.Visible = True
    oWord.Documents.Add Template:=App.Path & "\testMianshi.dot"
    
    With oWord.ActiveDocument.Paragraphs(4).Range
        .Font.Size = 18
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .InsertBefore Text:=testName
    End With
    
    With oWord.ActiveDocument.Paragraphs(14).Range
        .Font.Size = 16
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .InsertDateTime DateTimeFormat:="yyyy年MM月dd日"
    End With
    
    sSQL = "select ITEM.QUES_CONTENT, ITEM.ANSWER " _
            & "from TEST, ITEM, TEST_ITEM " _
            & " where TEST.TEST_ID = " & testId _
            & " and TEST.TEST_ID = TEST_ITEM.TEST_ID" _
            & " and ITEM.ITEM_ID = TEST_ITEM.ITEM_ID " _
            & " order by ITEM.CATEGORY_ID"
    rs.CursorLocation = adUseClient
    rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly

    For i = 1 To 8
        Set myCell = oWord.ActiveDocument.Tables(i).Cell(Row:=2, Column:=2)
        myCell.Range.InsertAfter Text:=rs!QUES_CONTENT
        Set myCell = oWord.ActiveDocument.Tables(i).Cell(Row:=3, Column:=2)
        myCell.Range.InsertAfter Text:=rs!ANSWER
        rs.MoveNext
    Next i
    
    rs.Close
    Set oWord = Nothing
    Screen.MousePointer = vbDefault
End Sub

Private Sub answerMianshi()
    Dim oWord As Word.Application
    Set oWord = New Word.Application
    oWord.Visible = True
    
    oWord.Documents.Add Template:=App.Path & "\answerMianshi.dot"

    Set oWord = Nothing
End Sub

Private Sub testGonggong()
    Screen.MousePointer = vbHourglass
    Dim i As Integer
    Dim quesIndex, quesTypeIndex As Integer
    Dim preQuesType As String
    Dim oWord As Word.Application
    Set oWord = New Word.Application
    oWord.Visible = True
    
    If categoryId = 1 Then
        oWord.Documents.Add Template:=App.Path & "\testGonggong.dot"
    ElseIf categoryId = 2 Then
        oWord.Documents.Add Template:=App.Path & "\testZhuanye.dot"
    End If
    
    With oWord.ActiveDocument.Paragraphs(4).Range
        .Font.Size = 24
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .InsertBefore Text:=testName
    End With
    
    sSQL = "select TEST_ITEM.ITEM_ID, ITEM.CATEGORY_ID, TEST.MAXMARK, TEST.DURATION, ITEM.TYPE_ID, ITEM.QUES_CONTENT, TEST_ITEM.SCORE " _
            & "from TEST, ITEM, TEST_ITEM " _
            & " where TEST.TEST_ID = " & testId _
            & " and TEST.TEST_ID = TEST_ITEM.TEST_ID" _
            & " and ITEM.ITEM_ID = TEST_ITEM.ITEM_ID " _
            & " order by ITEM.TYPE_ID"
    rs.CursorLocation = adUseClient
    rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly
    
    With oWord.ActiveDocument.Paragraphs(12).Range
        .InsertBefore Text:="    本试卷满分为" & rs!MAXMARK & "分，考试时间为" & rs!DURATION & "分钟。"
    End With
        
    With oWord.ActiveDocument.Paragraphs(15).Range
        .InsertParagraphAfter
        .Font.Size = 10
        .Font.Bold = False
       quesTypeIndex = 1
        For i = 1 To rs.RecordCount
            If i = 1 Or preQuesType <> rs!TYPE_ID Then
                .InsertAfter Text:=convertIndex(quesTypeIndex)
                .InsertAfter Text:=getTypeDescription & "（每小题" & rs!SCORE & "分）" & vbCrLf & vbCrLf
                quesTypeIndex = quesTypeIndex + 1
                quesIndex = 1
            End If
            .InsertAfter Text:=quesIndex & ". " & rs!QUES_CONTENT & vbCrLf & vbCrLf
            preQuesType = rs!TYPE_ID
            quesIndex = quesIndex + 1
            rs.MoveNext
        Next i
    End With
    rs.Close
    Set oWord = Nothing
    Screen.MousePointer = vbDefault
End Sub

Private Function getTypeDescription() As String
    Dim rsDes As adodb.Recordset
    Set rsDes = New Recordset
    rsDes.CursorLocation = adUseClient
    
    Dim i(4) As Integer
    i(0) = rs!CATEGORY_ID
    i(1) = getSuperId(i(0))
    i(2) = getSuperId(i(1))
    
    If i(2) = -1 Then
        sSQL = "select DESCRIPTION from ITEM_TYPE where TYPE_ID = " & rs!TYPE_ID _
             & " and CATEGORY_ID = 3"
    Else
        i(3) = getSuperId(i(2))
        sSQL = "select DESCRIPTION from ITEM_TYPE where TYPE_ID = '" & rs!TYPE_ID _
             & "' and CATEGORY_ID = " & i(3)
    End If
    
    rsDes.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly
    getTypeDescription = rsDes!Description
    
End Function

Private Sub answerGonggong()
    Screen.MousePointer = vbHourglass
    Dim i As Integer
    Dim quesIndex, quesTypeIndex As Integer
    Dim preQuesType As String
    Dim oWord As Word.Application
    Set oWord = New Word.Application
    oWord.Visible = True
    oWord.Documents.Add
    
    sSQL = "select TEST_ITEM.ITEM_ID, ITEM.CATEGORY_ID, TEST.MAXMARK, TEST.DURATION, ITEM.TYPE_ID, ITEM.ANSWER, TEST_ITEM.SCORE " _
            & "from TEST, ITEM, TEST_ITEM " _
            & " where TEST.TEST_ID = " & testId _
            & " and TEST.TEST_ID = TEST_ITEM.TEST_ID" _
            & " and ITEM.ITEM_ID = TEST_ITEM.ITEM_ID " _
            & " order by ITEM.TYPE_ID"
    rs.CursorLocation = adUseClient
    rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly
    
    With oWord.ActiveDocument.Content
        .InsertAfter Text:="====================================================================" & vbCrLf & vbCrLf
        .InsertAfter Text:="            " & testName & "（试题参考答案）" & vbCrLf
        .InsertAfter Text:="====================================================================" & vbCrLf & vbCrLf
 
'oWord.ActiveDocument.Paragraphs(2).Range.InsertBreak Type:=wdPageBreak
       ' .InsertBreak Type:=wdPageBreak
       quesTypeIndex = 1
        For i = 1 To rs.RecordCount
            If i = 1 Or preQuesType <> rs!TYPE_ID Then
                .InsertAfter Text:=convertIndex(quesTypeIndex)
                .InsertAfter Text:=getTypeDescription & "（每小题" & rs!SCORE & "分）" & vbCrLf & vbCrLf
                quesTypeIndex = quesTypeIndex + 1
                quesIndex = 1
            End If
            .InsertAfter Text:=quesIndex & ". " & rs!ANSWER & vbCrLf & vbCrLf
            preQuesType = rs!TYPE_ID
            quesIndex = quesIndex + 1
            rs.MoveNext
        Next i
    End With
    rs.Close
    Set oWord = Nothing
    Screen.MousePointer = vbDefault
End Sub


Private Function convertIndex(ByVal typeIndex As Integer) As String
    Dim s As String
    Select Case typeIndex
        Case 1
            s = "一、"
        Case 2
            s = "二、"
        Case 3
            s = "三、"
        Case 4
            s = "四、"
        Case 5
            s = "五、"
        Case 6
            s = "六、"
        Case 7
            s = "七、"
        Case 8
            s = "八、"
        Case 9
            s = "九、"
        Case 10
            s = "十、"
    End Select
    convertIndex = s
End Function