frmkm.frm

来自「能分班系统采用Z线分班方法：即由系统自动抽签(也可由班主任抽签)」· FRM 代码 · 共 648 行 · 第 1/2 页

    KG = True
End Sub



Private Sub Command2_Click()
    On Error Resume Next
    KG = False
    Cmd1.FileName = ""
    Cmd1.CancelError = True
    Cmd1.InitDir = App.Path
    Cmd1.Flags = cdlOFNHideReadOnly
    Cmd1.Filter = "EXCEL文件(*.XLS)|*.XLS|"
    Cmd1.ShowOpen
    '        Me.Caption = CMD1.Filter
    '         If CMD1.Filter = "EXCEL文件(*.XLS)|*.XLS|" Then Me.Caption = "EXCEL"
    If Cmd1.FileName = "" Then
        Me.Enabled = True
        Exit Sub
    Else

        Dim 科目  As String
        Dim a
        科目 = InputBox("请输入要导入的工作表名：", "指定数据对象")
        If 科目 = "" Then


            Exit Sub
        Else
            Dim astr As String
            Dim dbAdd As Database
            Set dbAdd = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
            astr = "DROP TABLE EXCLE"
            dbAdd.Execute astr
            dbAdd.Close
            Set dbAdd = Nothing
            ExportExcelSheetToAccess 科目, Cmd1.FileName, "EXCLE", App.Path & "\TEMP\" & HHVI & ".NHB"
            FRMEXCEL.Show 1, FRMkm
            Data1.DatabaseName = App.Path & "\TEMP\" & HHVI & ".NHB"
            Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
            Data1.Refresh


        End If
    End If

    Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
    Set rs = db.OpenRecordset("NHB")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext                     '得到数据库中的总数目
    Loop
    '############################################################################
    Dim III As Long
    For III = 1 To NUM + 10
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next                          '在表格左列显示数据总数目
    '############################################################################
End Sub

Private Sub Command3_Click()
    On Error Resume Next
    MousePointer = vbHourglass
    Dim III As Long
    For III = 1 To VSFlexGrid1.Rows



        If VSFlexGrid1.TextMatrix(III, 3) = "-1" Then

            VSFlexGrid1.TextMatrix(III, 3) = "男"



        End If


        If VSFlexGrid1.TextMatrix(III, 3) = "0" Then

            VSFlexGrid1.TextMatrix(III, 3) = "女"



        End If

    Next
    MousePointer = vbDefault
    MsgBox "性别格式转换成功!!!", 32, "提示"
    '        Command3.Enabled = False
End Sub

Private Sub Command4_Click()
    On Error Resume Next
    MsgBox "此操作将删除当前所有已录入的数据！！！", vbOKOnly, "警告！"
    Select Case MsgBox("是否真的删除记录吗？", vbOKCancel, "警告！")
        Case vbOK
            Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
            STR = "DELETE * from NHB"
            db.Execute STR
            db.Close
            Data1.DatabaseName = App.Path & "\TEMP\" & HHVI & ".NHB"
            Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
            Data1.Refresh
        Case Else
            Cancel = True
    End Select
End Sub

Private Sub Command5_Click()
    On Error GoTo deldata
    MsgBox "请您删除记录前，选对要删除的对象，否则数据库可能被您意处删除其它数据！！！", vbOKOnly, "警告！"
    Select Case MsgBox("是否真的删除记录吗？", vbOKCancel, "警告！")
        Case vbOK
            Data1.Recordset.Delete
            Data1.Recordset.MoveNext
            If Data1.Recordset.EOF = True Then
                Data1.Recordset.MovePrevious
            End If
            Data1.Refresh
        Case Else
            Cancel = True
    End Select
deldata:
    Select Case Err.Number
        Case 3021
            MsgBox "没有找到要删除的对象！", 32, "提示"
    End Select
End Sub

Private Sub Command6_Click()
    On Error Resume Next
    Select Case MsgBox("数据未保存,是否真的退出程序吗？", vbOKCancel, "警告！")
        Case vbOK
            Unload Me
        Case Else
            Cancel = True
    End Select
End Sub

Private Sub Command7_Click()
    On Error Resume Next
    '      On Error Resume Next
    If KG = False Then
        Dim s$
        Open App.Path & "\readme.txt" For Binary As #1
        s = Input(LOF(1), 1)
        Close #1
        MsgBox s, vbInformation, "保存数据注意点："
        Select Case MsgBox("是否真的保存数据后退出？", vbOKCancel, "警告！")
            Case vbOK
                MousePointer = vbHourglass
                DoEvents
                Call Command9_Click
                SHFileOp.wFunc = FO_COPY
                SHFileOp.pFrom = App.Path & "\TEMP\" & HHVI & ".NHB"
                SHFileOp.pTo = App.Path & "\DATA\" & HHVI & ".NHB"
                SHFileOp.fFlags = FOF_NOCONFIRMMKDIR
                Call SHFileOperation(SHFileOp)
                MsgBox "" & App.Path & "\DATA\" & HHVI & ".NHB", 64, "数据成功保存在"
                MousePointer = vbDefault

                Unload Me
            Case Else
                Cancel = True
        End Select

    Else



        Open App.Path & "\readme.txt" For Binary As #1
        s = Input(LOF(1), 1)
        Close #1
        MsgBox s, vbInformation, "保存数据注意点："
        Select Case MsgBox("是否真的保存数据后退出？", vbOKCancel, "警告！")
            Case vbOK
                MousePointer = vbHourglass
                SHFileOp.wFunc = FO_COPY
                SHFileOp.pFrom = Cmd1.FileName
                SHFileOp.pTo = App.Path & "\DATA\" & HHVI & ".NHB"
                SHFileOp.fFlags = FOF_NOCONFIRMMKDIR
                Call SHFileOperation(SHFileOp)
                MousePointer = vbDefault
                Set db = OpenDatabase(App.Path & "\DATA\" & HHVI & ".NHB")
                STR = "DELETE * from NHB WHERE 学号="" or 分数="""
                db.Execute STR
                db.Close
                Unload Me
            Case Else
                Cancel = True
        End Select



    End If


End Sub

Private Sub Command9_Click()
    On Error Resume Next
    ' On Error Resume Next
    Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
    STR = "DELETE * from NHB WHERE 学号="" or 分数="""
    db.Execute STR
    db.Close
    '                        Data1.DatabaseName = App.Path & "\TEMP\" & HHVI & ".NHB"
    '                        Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
    '                        Data1.Refresh
End Sub

Private Sub Form_Load()
    MAIN.Enabled = False
    Skin1.ApplySkin Me.hwnd
    Me.Caption = HHVI & "   (智能分班数据)"

    Data1.DatabaseName = App.Path & "\TEMP\" & HHVI & ".NHB"
    Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
    Data1.Refresh
    Dim intCounter As Long
    For intCounter = 1 To 500
        Combo3.AddItem intCounter
    Next intCounter
    Combo3.ListIndex = 0
    DoEvents
    Dim s$
    s = "|男|女"
    Me.VSFlexGrid1.ColComboList(3) = s
    KG = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    MAIN.Enabled = True
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
End Sub

Private Sub Combo3_Click()
    On Error Resume Next
    MousePointer = vbHourglass
    Dim ii As Long
    For ii = 1 To Combo3
        Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
        STR = "INSERT INTO NHB (ID) VALUES ('" & ii & "')"
        db.Execute STR
        db.Close               '自动生成十行空数据
    Next
    Data1.DatabaseName = App.Path & "\TEMP\" & HHVI & ".NHB"
    Data1.RecordSource = "SELECT 学号,姓名,性别,分数 FROM NHB"
    Data1.Refresh
    '############################################################################
    Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
    Set rs = db.OpenRecordset("NHB")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext                     '得到数据库中的总数目
    Loop
    '############################################################################
    Dim III As Long
    For III = 1 To NUM + 10
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next                          '在表格左列显示数据总数目
    '############################################################################
    MousePointer = vbDefault
End Sub



'Private Sub VSFlexGrid1_BeforeRowColChange(ByVal OldRow As Long, ByVal OldCol As Long, ByVal NewRow As Long, ByVal NewCol As Long, Cancel As Boolean)
''        On Error Resume Next
'        If VSFlexGrid1.Col = 3 Then '固定检查第三列数据
'                If Val(VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 3)) <> 男 Then
'                        MsgBox "性别只能用男女来表示", 32, "无法保存"
'                        VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 3) = ""
'                End If
'        End If             '
'        '##########################################################3
'
'End Sub
Private Sub VSFlexGrid1_Click()
    On Error Resume Next
    Data1.Recordset.AbsolutePosition = VSFlexGrid1.Row - 1
    '点击表格时，同时将DATA1的数据同步显示，确保准确删除数据
End Sub
Private Sub VSFlexGrid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
    On Error Resume Next
    If VSFlexGrid1.Col = 4 Then
        Select Case KeyAscii
            Case 48 To 57, 8
            Case 46
                If InStr(VSFlexGrid1.TextMatrix(VSFlexGrid1.Row, VSFlexGrid1.Col), ".") <> 0 Then
                    KeyAscii = 0
                End If
            Case Else
                KeyAscii = 0
        End Select
    End If

    If VSFlexGrid1.Col = 3 Then

        KeyAscii = 0

    End If

End Sub