tea_cx.frm

这是一个非常 好的一个程序进行体会一下学生管理系统

    Next i
    For i = 0 To 6
        If Combo1(i) <> "" Then GoTo search
    Next i
    MsgBox "请输入查询条件！", 0 + 48 + 0, "注意！"
    Text1(0).SetFocus
    Exit Sub
search:
    myFlexGrid.Rows = 1
    txtSQL = "select * from Tea_info where "
    Dim blank As Boolean
    blank = False
    '以下将查询进行复合
    If Text1(0).Text <> "" Then '职工号
      txtSQL = txtSQL + "Tea_id=" & "'" & Trim(Text1(0).Text) & "'"
      blank = True
    End If
    If Text1(1).Text <> "" Then '姓名
      If blank Then
        txtSQL = txtSQL + " and Tea_name=" & "'" & Trim(Text1(1).Text) & "'"
      Else
        txtSQL = txtSQL + " Tea_name=" & "'" & Trim(Text1(1).Text) & "'"
        blank = True
      End If
    End If
    If Text1(2).Text <> "" Then '出生年月
      If Not IsDate(Text1(2).Text) Then
         MsgBox "日期格式不标准，请重新填写！", 0 + 48 + 0, "注意！"
         Text1(2).SetFocus
         Exit Sub
      End If
      If blank Then
        txtSQL = txtSQL + " and Tea_sr=" & Trim(Format(Text1(2).Text, "yy-m-d")) & ""
      Else
        txtSQL = txtSQL + " Tea_sr=" & Trim(Format(Text1(2).Text, "yy-m-d")) & ""
        blank = True
      End If
    End If
    If Text1(3).Text <> "" Then '参加工作日期
      If Not IsDate(Text1(2).Text) Then
         MsgBox "日期格式不标准，请重新填写！", 0 + 48 + 0, "注意！"
         Text1(3).SetFocus
         Exit Sub
      End If
      If blank Then
        txtSQL = txtSQL + " and Tea_join=" & Trim(Format(Text1(3).Text, "yy-m-d")) & ""
      Else
        txtSQL = txtSQL + " Tea_join=" & Trim(Format(Text1(3).Text, "yy-m-d")) & ""
        blank = True
      End If
    End If
    If Combo1(0).Text = "男" Then '性别
        If blank Then
            txtSQL = txtSQL + " and Tea_sex = 1"
        Else
            txtSQL = txtSQL + " Tea_sex = 1"
            blank = True
        End If
    Else
        If Combo1(0).Text = "女" Then
            If blank Then
                txtSQL = txtSQL + " and Tea_sex =0"
            Else
                txtSQL = txtSQL + " Tea_sex = 0"
                blank = True
            End If
      End If
    End If
    If Combo2(0).Text <> "" And Combo1(1).Text <> "" Then '学历
      If blank Then
        txtSQL = txtSQL + " and Tea_xl" & Combo2(0).Text & Combo1(1).ListIndex
      Else
        txtSQL = txtSQL + " Tea_xl" & Combo2(0).Text & Combo1(1).ListIndex
        blank = True
      End If
    End If
    
    If Combo2(1).Text <> "" And Combo1(2).Text <> "" Then '职称
      txtSQL1 = "select Prof_value from Prof_info where Prof_name = " & "'" & Combo1(2).Text & "'"
      Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
      temp = mrc1.Fields(0)
      mrc1.Close
      Set mrc1 = Nothing
      Select Case Combo2(1).Text
        Case ">=", "<"
            temp = temp / 10
            temp = temp * 10
        Case ">", "<="
            temp = temp / 10 + 1
            temp = temp * 10
      End Select
      If blank Then
            txtSQL = txtSQL + " and Tea_zc " & Combo2(1).Text & temp
      Else
            txtSQL = txtSQL + " Tea_zc " & Combo2(1).Text & temp
            blank = True
      End If
    End If
    
    If Combo1(3).Text <> "" Then '所属系部
      If blank Then
        txtSQL = txtSQL + " and Tea_belong = " & Combo1(3).ListIndex
      Else
        txtSQL = txtSQL + " Tea_belong = " & Combo1(3).ListIndex
        blank = True
      End If
    End If
    If Combo2(2).Text <> "" And Combo1(4).Text <> "" Then  '职务
      txtSQL1 = "select Tzw_value from Tzw_info where Tzw_name = " & "'" & Combo1(4).Text & "'"
      Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
      temp = mrc1.Fields(0)
      mrc1.Close
      Set mrc1 = Nothing
      Select Case Combo2(2).Text
        Case ">=", "<"
            temp = temp / 10
            temp = temp * 10
        Case ">", "<="
            temp = temp / 10 + 1
            temp = temp * 10
      End Select
      If blank Then
            txtSQL = txtSQL + " and Tea_zw " & Combo2(2).Text & temp
      Else
            txtSQL = txtSQL + " Tea_zw " & Combo2(2).Text & temp
            blank = True
      End If
    End If
    If Combo2(3).Text <> "" And Combo1(5).Text <> "" Then  '岗位级别
      If blank Then
        txtSQL = txtSQL + " and Tea_rank " & Combo2(3).Text & Combo1(5).Text
      Else
        txtSQL = txtSQL + " Tea_rank " & Combo2(3).Text & Val(Combo1(5).Text)
        blank = True
      End If
    End If
    If Combo1(6).Text = "是" Then '是否为班导师
        If blank Then
            txtSQL = txtSQL + " and Tea_bd = True"
        Else
            txtSQL = txtSQL + " Tea_bd = True"
            blank = True
        End If
    Else
        If Combo1(6).Text = "否" Then
            If blank Then
                txtSQL = txtSQL + " and Tea_bd =False"
            Else
                txtSQL = txtSQL + " Tea_bd = False"
                blank = True
            End If
      End If
    End If
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
       MsgBox "没有符合条件的记录！", 0 + 48 + 0, "注意！"
       Exit Sub
    End If
    With myFlexGrid  '将查询结果显示出来
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            .CellAlignment = 2
            If Not IsNull(mrc.Fields(0)) Then
               .TextMatrix(.Rows - 1, 0) = mrc.Fields(0)
            End If
            If Not IsNull(mrc.Fields(1)) Then
                .TextMatrix(.Rows - 1, 1) = mrc.Fields(1)
            End If
            If mrc.Fields(2) Then
                .TextMatrix(.Rows - 1, 2) = "男"
            Else
                .TextMatrix(.Rows - 1, 2) = "女"
            End If
            If Not IsNull(mrc.Fields(3)) Then '学历
                txtSQL1 = "select Xl_name from Xl_info where Xl_value = " & mrc.Fields(3)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(4)) Then '职称
                txtSQL1 = "select Prof_name from Prof_info where Prof_value = " & mrc.Fields(4)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 4) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(5)) Then '所属系部
                txtSQL1 = "select Depart_name from Depart_info where Depart_value = " & mrc.Fields(5)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 5) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(6)) Then '职务
                txtSQL1 = "select Tzw_name from Tzw_info where Tzw_value = " & mrc.Fields(6)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 6) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(7)) Then '岗位级别
               .TextMatrix(.Rows - 1, 7) = mrc.Fields(7)
            End If
            If mrc.Fields(8) Then '是否为班导师
                .TextMatrix(.Rows - 1, 8) = "是"
            Else
                .TextMatrix(.Rows - 1, 8) = "否"
            End If
            For i = 9 To 18
                If Not IsNull(mrc.Fields(i)) Then '所带班级，出生年月，参加工作日期，毕业学校，毕业时间，家庭地址，家庭电话，办公室电话，手机，备注
                    .TextMatrix(.Rows - 1, i) = mrc.Fields(i)
                End If
            Next i
            mrc.MoveNext
         Loop
    End With
    Command3.Enabled = True '导出打印按钮有效
End Sub

Private Sub Command2_Click() '条件重置按钮
Dim i As Integer
    For i = 0 To 3
        Text1(i) = ""
    Next
    For i = 0 To 6
        Combo1(i).Text = ""
    Next i
    For i = 0 To 3
        Combo2(i).Text = "="
    Next i
    myFlexGrid.Rows = 1 '初始化myFlexGrid
    Command3.Enabled = False '导出打印按钮无效
End Sub

Private Sub Command3_Click() '结果导出按钮
On Error Resume Next
    Dim colnum As Integer '存字段数量
    Dim row As Integer  '用来记录excel表的当前行
    Dim Fieldlen() '存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    If mrc.RecordCount = 0 Then
        MsgBox "查询结果为空，请重新查询！", 0 + 48, "注意！"
        Command2.SetFocus
        Exit Sub
    End If
    colnum = myFlexGrid.Cols
    ReDim Fieldlen(colnum)
    '往表内写入标题
    xlSheet.Cells(1, 2).Value = "教师信息查询结果表 "
    '往表内写入字段名
    For i = 0 To colnum - 1
        xlSheet.Cells(3, i + 1).Value = myFlexGrid.TextMatrix(0, i)
        Fieldlen(i) = LenB(myFlexGrid.TextMatrix(0, i))
    Next i
    '开始往表内写查询结果
    mrc.MoveFirst
    row = 4
    While Not mrc.EOF
        If IsNull(mrc.Fields(0)) = False Then '对于职工号特殊处理，以防自动截去学号前几位的0
                xlSheet.Cells(row, 1).Value = mrc.Fields(0)
                If LenB(mrc.Fields(0)) > Fieldlen(0) Then '将字段的最大长度保存在Fieldlen()数组中
                    Fieldlen(0) = LenB(mrc.Fields(0))
                    xlSheet.Columns(1).ColumnWidth = Fieldlen(0)
                End If
            End If
        For i = 1 To colnum - 1
            If IsNull(mrc.Fields(i)) = False Then
                xlSheet.Cells(row, i + 1).Value = Trim(myFlexGrid.TextMatrix(row - 3, i))
                If LenB(myFlexGrid.TextMatrix(row - 3, i)) > Fieldlen(i) Then '将字段的最大长度保存在Fieldlen()数组中
                    Fieldlen(i) = LenB(myFlexGrid.TextMatrix(row - 3, i))
                    xlSheet.Columns(i + 1).ColumnWidth = Fieldlen(i)
                End If
            End If
        Next i
        mrc.MoveNext
        row = row + 1
    Wend
    With xlSheet
        .Cells(1, 2).Font.Name = "黑体" '设标题为黑体字
        .Cells(1, 2).Font.Size = 24   '标题字体大小为24
        .Range(.Cells(3, 1), .Cells(row - 1, colnum)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    xlApp.Visible = True '显示表格
    xlBook.Save '保存'
    Set xlApp = Nothing '交还控制给Excel
End Sub

Private Sub Form_Load()
    With myFlexGrid '初始化显示查询结果的控件
         .Rows = 1
         For i = 0 To 18
            .ColAlignment(i) = 3
         Next i
         .TextMatrix(0, 0) = "职工号"
         .TextMatrix(0, 1) = "姓 名"
         .TextMatrix(0, 2) = "性 别"
         .TextMatrix(0, 3) = "学 历"
         .TextMatrix(0, 4) = "职 称"
         .TextMatrix(0, 5) = "所属系部"
         .TextMatrix(0, 6) = "职 务"
         .TextMatrix(0, 7) = "岗位等级"
         .TextMatrix(0, 8) = "是否为班导师"
         .TextMatrix(0, 9) = "所带班级"
         .TextMatrix(0, 10) = "出身年月"
         .TextMatrix(0, 11) = "参加工作日期"
         .TextMatrix(0, 12) = "毕业学校"
         .TextMatrix(0, 13) = "毕业时间"
         .TextMatrix(0, 14) = "家庭地址"
         .TextMatrix(0, 15) = "家庭电话"
         .TextMatrix(0, 16) = "办公电话"
         .TextMatrix(0, 17) = "手 机"
         .TextMatrix(0, 18) = "备注信息"
         For i = 0 To 18
            .ColAlignment(i) = 3
         Next i
         .ColWidth(6) = 1500
         .ColWidth(8) = 1500
         .ColWidth(11) = 1500
         .ColWidth(12) = 1500
         .ColWidth(14) = 2500
         .ColWidth(18) = 1500
    End With
     '初始化学历选择框
    txtSQL1 = "select Xl_name from Xl_info order by Xl_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(1).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化职称选择框
    txtSQL1 = "select Prof_name from Prof_info order by Prof_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(2).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化所属系部选择框
    txtSQL1 = "select Depart_name from Depart_info order by Depart_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(3).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化职务选择框
    txtSQL1 = "select Tzw_name from Tzw_info order by Tzw_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(4).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call Command1_Click
    End If
End Sub