mainmid.frm

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

Private Sub Stu_cx_Click(Index As Integer)  '学生信息查询菜单
    Form4.Show
    Form4.SetFocus
End Sub

Private Sub Stu_edit_Click(Index As Integer) '学生信息编辑菜单
    Form5.Show
    Form5.SetFocus
End Sub

Private Sub Stu_in_Click(Index As Integer) '学生信息导入菜单
Dim mrc As ADODB.Recordset
Dim txtSQL As String
Dim strCnn As String
Dim fname As String
Dim i As Long
Dim j As Long
Dim strName As String
Dim myApp As Excel.Application
Dim myWorkbook As Excel.Workbook
Dim mySheet As Excel.Worksheet
     
On Error GoTo ErrInfo
    If myApp Is Nothing Then
        Set myApp = CreateObject("Excel.Application") '创建Excel类实例
    End If
    With Dialog
        .DefaultExt = "xls"
        .DialogTitle = "学生基本信息导入"
        .CancelError = True
        .Filter = "Excel 文件(*.xls)|*.xls"
        .ShowOpen
    End With
    fname = Dialog.FileName
    Set myWorkbook = myApp.Workbooks.Open(fname) '打开导入文件
    Set mySheet = myWorkbook.Worksheets.Item(1)
    txtSQL = "select * from Stu_info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    strName = mySheet.Cells(1, 1)
    i = 1
    Do Until strName = ""
        mrc.AddNew
        Select Case Len(mySheet.Cells(i, 1)) '加上在excel中自动省去的0
            Case 6:
                mrc!Stu_no = "000" & mySheet.Cells(i, 1)
            Case 8:
                mrc!Stu_no = "0" & mySheet.Cells(i, 1)
        End Select
        mrc!Stu_name = mySheet.Cells(i, 2)
        mrc.Update
        i = i + 1
        strName = mySheet.Cells(i, 1)
    Loop
    mrc.Close
    myApp.Workbooks.Close
    Set mrc = Nothing
    Set myWorkbook = Nothing
    Set mySheet = Nothing
    Set myApp = Nothing
    MsgBox "导入完毕！", 0 + 64, "恭喜！"
    Exit Sub
ErrInfo:
    Select Case Err.Number
        Case 1004
            MsgBox "请选择正确的Excel文件！", vbInformation, "错误"
        Case 3265
            MsgBox "应用程序找不到对象！", vbInformation, "错误"
        Case -2147217887
            MsgBox "关键字重复，导入失败！", 0 + 48, "错误"
    End Select
    myApp.Workbooks.Close
    Set mrc = Nothing
    Set myWorkbook = Nothing
    Set mySheet = Nothing
    Set myApp = Nothing
    Exit Sub
End Sub

Private Sub Stu_out_Click(Index As Integer) '学生信息导出菜单
Dim mrc, mrc1 As ADODB.Recordset
Dim txtSQL, txtSQL1, strCnn As String
Dim myApp As Excel.Application
Dim myWorkbook As Excel.Workbook
Dim mySheet As Excel.Worksheet
Dim fname As String
Dim colnum, row As Integer
Dim i As Integer
Dim flen() As Integer

 'On Error GoTo ErrHandler
    If myApp Is Nothing Then
        Set myApp = CreateObject("Excel.Application") '创建Excel类实例
    End If
    Set myWorkbook = myApp.Workbooks.Add
    Set mySheet = myWorkbook.Worksheets(1)
    mySheet.Cells(1, 2).Value = "学生基本信息表"
    txtSQL = "select * from Stu_info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    colnum = mrc.Fields.Count
    ReDim flen(colnum)
    With mySheet
        .Cells(3, 1).Value = "学号"
        .Cells(3, 2).Value = "姓名"
        .Cells(3, 3).Value = "性别"
        .Cells(3, 4).Value = "班级"
        .Cells(3, 5).Value = "学历"
        .Cells(3, 6).Value = "学制"
        .Cells(3, 7).Value = "生源"
        .Cells(3, 8).Value = "籍贯"
        .Cells(3, 9).Value = "出生年月"
        .Cells(3, 10).Value = "专业"
        .Cells(3, 11).Value = "政治面貌"
        .Cells(3, 12).Value = "职务"
        .Cells(3, 13).Value = "民族"
        .Cells(3, 14).Value = "备注"
        For i = 0 To 13
            flen(i) = .Columns(i + 1).ColumnWidth
        Next i
    End With
    row = 4
    mrc.MoveFirst
    While Not mrc.EOF
        For i = 0 To 1
            If IsNull(mrc.Fields(i)) = False Then
                mySheet.Cells(row, i + 1).Value = mrc.Fields(i)
                If LenB(mrc.Fields(i)) > flen(i) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(i) = LenB(mrc.Fields(i))
                    mySheet.Columns(i + 1).ColumnWidth = flen(i)
                End If
            End If
        Next i
        '填入性别
        If mrc.Fields(2) Then
            mySheet.Cells(row, 3).Value = "男"
        Else
            mySheet.Cells(row, 3).Value = "女"
        End If
        If IsNull(mrc.Fields(3)) = False Then '班级
                mySheet.Cells(row, 4).Value = mrc.Fields(3)
                If LenB(mrc.Fields(3)) > flen(3) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(3) = LenB(mrc.Fields(3))
                    mySheet.Columns(4).ColumnWidth = flen(3)
                End If
        End If
        If IsNull(mrc.Fields(4)) = False Then '学历
                txtSQL1 = "select Xl_name from Xl_info where Xl_value = " & mrc.Fields(4)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 5).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(4) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(4) = LenB(mrc1.Fields(0))
                    mySheet.Columns(5).ColumnWidth = flen(4)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        If IsNull(mrc.Fields(5)) = False Then '学制
                mySheet.Cells(row, 6).Value = mrc.Fields(5)
                If LenB(mrc.Fields(5)) > flen(5) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(5) = LenB(mrc.Fields(5))
                    mySheet.Columns(6).ColumnWidth = flen(5)
                End If
        End If
        If IsNull(mrc.Fields(6)) = False Then '生源
                txtSQL1 = "select Province_name from Province_info where Province_value = " & mrc.Fields(6)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 7).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(6) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(6) = LenB(mrc1.Fields(0))
                    mySheet.Columns(7).ColumnWidth = flen(6)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        If IsNull(mrc.Fields(7)) = False Then '籍贯
                txtSQL1 = "select Province_name from Province_info where Province_value = " & mrc.Fields(7)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 8).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(7) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(7) = LenB(mrc1.Fields(0))
                    mySheet.Columns(8).ColumnWidth = flen(7)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        For i = 8 To 9 '出生年月，专业
            If IsNull(mrc.Fields(i)) = False Then
                mySheet.Cells(row, i + 1).Value = mrc.Fields(i)
                If LenB(mrc.Fields(i)) > flen(i) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(i) = LenB(mrc.Fields(i))
                    mySheet.Columns(i + 1).ColumnWidth = flen(i)
                End If
            End If
        Next i
        If IsNull(mrc.Fields(10)) = False Then '政治面貌
                txtSQL1 = "select Mm_name from Mm_info where Mm_value = " & mrc.Fields(10)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 11).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(10) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(10) = LenB(mrc1.Fields(0))
                    mySheet.Columns(11).ColumnWidth = flen(10)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        If IsNull(mrc.Fields(11)) = False Then '职务
                txtSQL1 = "select Szw_name from Szw_info where Szw_value = " & mrc.Fields(11)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 12).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(11) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(11) = LenB(mrc1.Fields(0))
                    mySheet.Columns(12).ColumnWidth = flen(11)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        If IsNull(mrc.Fields(12)) = False Then '民族
                txtSQL1 = "select Ration_name from Ration_info where Ration_value = " & mrc.Fields(12)
                Set mrc1 = ExecuteSQL(txtSQL1, MsgText)
                mySheet.Cells(row, 13).Value = mrc1.Fields(0)
                If LenB(mrc1.Fields(0)) > flen(12) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(12) = LenB(mrc1.Fields(0))
                    mySheet.Columns(13).ColumnWidth = flen(12)
                End If
                mrc1.Close
                Set mrc1 = Nothing
        End If
        If IsNull(mrc.Fields(13)) = False Then '备注
                mySheet.Cells(row, 14).Value = mrc.Fields(13)
                If LenB(mrc.Fields(13)) > flen(13) Then  '将字段的最大长度保存在Fieldlen()数组中
                    flen(13) = LenB(mrc.Fields(13))
                    mySheet.Columns(14).ColumnWidth = flen(13)
                End If
        End If
        mrc.MoveNext
        row = row + 1
    Wend
    With mySheet
        .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
    myApp.Visible = True
    mrc.Close
    Set mrc = Nothing
    Set mySheet = Nothing
    Set myWorkbook = Nothing
    Set myApp = Nothing
Exit Sub
ErrHandler:
    Select Case Err.Number
        Case 1004
            MsgBox "请选择正确的Excel文件！", vbInformation, "错误"
        Case 32755 '点“取消”
        Case 3265
            MsgBox "应用程序找不到对象！", vbInformation, "错误"
    End Select
    myApp.Workbooks.Close
    Set mrc = Nothing
    Set mySheet = Nothing
    Set myWorkbook = Nothing
    Set myApp = Nothing
    Exit Sub
End Sub

Private Sub Tea_cx_Click()  '教师信息查询菜单
    Form15.Show
    Form15.SetFocus
End Sub

Private Sub Tea_edit_Click() '教师信息编辑菜单
    Form14.Show
    Form14.SetFocus
End Sub

Private Sub Timer1_Timer()
    StatusBar1(0).Panels(4).Text = Format(Now, "H:mm:ss")
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '工具栏选项
    Select Case Button.Index
        Case 1:
            Form4.Show
            Form4.SetFocus
        Case 2:
            Form15.Show
            Form15.SetFocus
        Case 3:
            Form7.Show
            Form7.SetFocus
        Case 4:
            Form8.Show
            Form8.SetFocus
        Case 5:
            Form9.Show
            Form9.SetFocus
        Case 6:
            Form19.Show
            Form19.SetFocus
        Case 7:
            Form11.Show
            Form11.SetFocus
    End Select
End Sub