stu_cx.frm

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

      Top             =   0
      Width           =   1575
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "RVB_UniqueId" ,"41FF01E202C8"
Attribute VB_Ext_KEY = "RVB_ModelStereotype" ,"Form"
Dim txtSQL As String
Private txtSQL1 As String   'ExecuteSQL 的 SQL语句参数
Dim mrc As ADODB.Recordset
Private mrc1 As ADODB.Recordset  '定义查询返回记录集
Dim MsgText As String

Private Sub Command1_Click()
Dim i As Integer   '判断是否填写查询条件
    For i = 0 To 3
        If Text1(i).Text <> "" Then GoTo search
    Next i
    For i = 0 To 8
        If Combo1(i) <> "" Then GoTo search
    Next i
    MsgBox "请输入查询条件！", 0 + 48 + 0, "注意！"
    Text1(0).SetFocus
    Exit Sub
search:
    myFlexGrid.Rows = 1
    txtSQL = "select * from Stu_info where "
    Dim blank As Boolean
    blank = False
    '以下将查询进行复合
    If Text1(0).Text <> "" Then '学号
      txtSQL = txtSQL + "Stu_no=" & "'" & Trim(Text1(0).Text) & "'"
      blank = True
    End If
    If Text1(1).Text <> "" Then '姓名
      If blank Then
        txtSQL = txtSQL + " and Stu_name=" & "'" & Trim(Text1(1).Text) & "'"
      Else
        txtSQL = txtSQL + " Stu_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 Stu_sr=" & Trim(Format(Text1(2).Text, "yy-m-d")) & ""
      Else
        txtSQL = txtSQL + " Stu_sr=" & Trim(Format(Text1(2).Text, "yy-m-d")) & ""
        blank = True
      End If
    End If
    If Text1(3).Text <> "" Then  '班级
      If blank Then
        txtSQL = txtSQL + "and Stu_class=" & "'" & Trim(Text1(3).Text) & "'"
      Else
        txtSQL = txtSQL + " Stu_class=" & "'" & Trim(Text1(3).Text) & "'"
        blank = True
      End If
    End If
    If Combo1(0).Text = "男" Then '性别
      If blank Then
        txtSQL = txtSQL + " and Stu_sex = 1"
      Else
        txtSQL = txtSQL + " Stu_sex = 1"
        blank = True
      End If
    Else
      If Combo1(0).Text = "女" Then
        If blank Then
          txtSQL = txtSQL + " and Stu_sex =0"
        Else
          txtSQL = txtSQL + " Stu_sex = 0"
          blank = True
        End If
      End If
    End If
    If Combo2(0) <> "" And Combo1(1).Text <> "" Then '学历
      If blank Then
        txtSQL = txtSQL + " and Stu_xl" & Combo2(0).Text & Combo1(1).ListIndex
      Else
        txtSQL = txtSQL + " Stu_xl " & Combo2(0).Text & Combo1(1).ListIndex
        blank = True
      End If
    End If
    If Combo2(1).Text <> "" And Combo1(2).Text <> "" Then  '学制
      If blank Then
        txtSQL = txtSQL + " and Stu_xz " & Combo2(1).Text & Combo1(2).Text
      Else
        txtSQL = txtSQL + " Stu_xz " & Combo2(1).Text & Combo1(2).Text
        blank = True
      End If
    End If
    If Combo1(3).Text <> "" Then '生源
      If blank Then
        txtSQL = txtSQL + " and Stu_sy = " & Combo1(3).ListIndex
      Else
        txtSQL = txtSQL + " Stu_sy = " & Combo1(3).ListIndex
        blank = True
      End If
    End If
    If Combo1(4).Text <> "" Then '籍贯
      If blank Then
        txtSQL = txtSQL + " and Stu_jg = " & Combo1(4).ListIndex
      Else
        txtSQL = txtSQL + " Stu_jg = " & Combo1(4).ListIndex
        blank = True
      End If
    End If
    If Combo1(5).Text <> "" Then '民族
      If blank Then
        txtSQL = txtSQL + " and Stu_mz = " & Combo1(5).ListIndex
      Else
        txtSQL = txtSQL + " Stu_mz = " & Combo1(5).ListIndex
        blank = True
      End If
    End If
    If Combo1(6).Text <> "" Then '职务
      If blank Then
        txtSQL = txtSQL + " and Stu_zw = " & Combo1(6).ListIndex
      Else
        txtSQL = txtSQL + " Stu_zw = " & Combo1(6).ListIndex
        blank = True
      End If
    End If
    If Combo1(7).Text <> "" Then '专业
      If blank Then
        txtSQL = txtSQL + " and Stu_zy = " & "'" & Trim(Combo1(7).Text) & "'"
      Else
        txtSQL = txtSQL + " Stu_zy = " & "'" & Trim(Combo1(7).Text) & "'"
        blank = True
      End If
     End If
    If Combo1(8).Text <> "" Then '政治面貌
      If blank Then
        txtSQL = txtSQL + " and Stu_mm = " & Combo1(8).ListIndex
      Else
        txtSQL = txtSQL + " Stu_mm = " & Combo1(8).ListIndex
        blank = True
      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
               .TextMatrix(.Rows - 1, 3) = mrc.Fields(3)
            End If
            If Not IsNull(mrc.Fields(4)) Then '学历
                txtSQL1 = "select Xl_name from Xl_info where Xl_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
               .TextMatrix(.Rows - 1, 5) = mrc.Fields(5)
            End If
            If Not IsNull(mrc.Fields(6)) Then '生源
                txtSQL1 = "select Province_name from Province_info where Province_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 '籍贯
                txtSQL1 = "select Province_name from Province_info where Province_value = " & mrc.Fields(7)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 7) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(8)) Then '出生年月
               .TextMatrix(.Rows - 1, 8) = mrc.Fields(8)
            End If
            If Not IsNull(mrc.Fields(9)) Then '专业
               .TextMatrix(.Rows - 1, 9) = mrc.Fields(9)
            End If
            If Not IsNull(mrc.Fields(10)) Then '政治面貌
                txtSQL1 = "select Mm_name from Mm_info where Mm_value = " & mrc.Fields(10)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 10) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(11)) Then '职务
                txtSQL1 = "select Szw_name from Szw_info where Szw_value = " & mrc.Fields(11)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 11) = mrc1.Fields(0)
                mrc1.Close
            End If
            If Not IsNull(mrc.Fields(12)) Then '民族
                txtSQL1 = "select Ration_name from Ration_info where Ration_value = " & mrc.Fields(12)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                .TextMatrix(.Rows - 1, 12) = mrc1.Fields(0)
                mrc1.Close
            End If
             If Not IsNull(mrc.Fields(13)) Then '备注
               .TextMatrix(.Rows - 1, 13) = mrc.Fields(13)
            End If
            mrc.MoveNext
         Loop
    End With
    Command3.Enabled = True '导出打印按钮有效
End Sub


'##ModelId=41FF01E401EF
Private Sub Command2_Click() '重制查询条件
Dim i As Integer
  For i = 0 To 3
    Text1(i) = ""
  Next
  For i = 0 To 8
    Combo1(i).Text = ""
  Next i
  For i = 0 To 1
    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 = 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

'##ModelId=41FF01E40203
Private Sub Form_Load()
    With myFlexGrid '初始化显示查询结果的控件
         .Rows = 1
         .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) = "备注"
         For i = 0 To 13
            .ColAlignment(i) = 3
         Next i
         .ColWidth(9) = 1500
         .ColWidth(13) = 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 Province_name from Province_info order by Province_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 Province_name from Province_info order by Province_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(4).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化民族选择框
    txtSQL1 = "select Ration_name from Ration_info order by Ration_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(5).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化职务选择框
    txtSQL1 = "select Szw_name from Szw_info order by Szw_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(6).AddItem mrc1.Fields(0)
        mrc1.MoveNext
    Wend
    mrc1.Close
    '初始化政治面貌选择框
    txtSQL1 = "select Mm_name from Mm_info order by Mm_value"
    Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
    mrc1.MoveFirst
    While Not mrc1.EOF
        Combo1(8).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