frmexcelin3.frm

1.如果在向导设置班级数为8时,此数值为班级总数

    Dim ii As Long
    For ii = 1 To Combo3
        Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
        STR = "INSERT INTO 学生 (ID) VALUES ('" & ii & "')"
        db.Execute STR
        db.Close               '自动生成十行空数据
    Next
    Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
    Data1.RecordSource = XS
    Data1.Refresh
    '############################################################################
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("学生")
    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 Command1_Click()
    On Error Resume Next
    Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
    Data1.RecordSource = XS & " ORDER BY " & "" & Combo2.Text & ""
    Data1.Refresh
    Dim III As Long
    For III = 1 To NUM
        VSFlexGrid1.TextMatrix(III, 0) = III
    Next
    Dim QQ As Long
    For QQ = 0 To VSFlexGrid1.Cols
        VSFlexGrid1.ColAlignment(QQ) = flexAlignCenterCenter
        ' VSFlexGrid1.CellAlignment = flexAlignCenterCenter
    Next QQ
End Sub



Private Sub Command3_Click()
    On Error Resume Next
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "DELETE * from 学生 WHERE 学籍=0 AND 班级=0 AND 学号=0"
    db.Execute STR
    db.Close
    Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
    Data1.RecordSource = XS
    Data1.Refresh
End Sub

'Private Sub Command2_Click()
'        On Error Resume Next
'        Dim ii As Long
'        For ii = 1 To 10
'                Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
'                STR = "INSERT INTO 学生 (ID) VALUES ('" & ii & "')"
'                db.Execute STR
'                db.Close               '自动生成十行空数据
'        Next
'        Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
'        Data1.RecordSource = XS
'        Data1.Refresh
'        '############################################################################
'        Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
'        Set rs = db.OpenRecordset("学生")
'        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
'        Me.Enabled = False
'        FRMdatain.Show
'End Sub
'Private Sub Command4_Click()
'        On Error Resume Next
'        MsgBox "此操作将删除当前所有已录入的数据！！！", vbOKOnly, "警告！"
'        Select Case MsgBox("是否真的删除记录吗？", vbOKCancel, "警告！")
'                Case vbOK
'                        Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
'                        STR = "DELETE * from 学生"
'                        db.Execute STR
'                        db.Close
'                        Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
'                        Data1.RecordSource = XS
'                        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
    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 Command3_Click
            '                        Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
            '                        STR = "DELETE * from 学生 where 班级=0"
            '                        db.Execute STR
            '                        db.Close
            '                        Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
            '                        Data1.RecordSource = XS
            '                        Data1.Refresh
            SHFileOp.wFunc = FO_COPY
            SHFileOp.pFrom = App.Path & "\TEMP\" & DD & ".NHB"
            SHFileOp.pTo = App.Path & "\EXCEL生成NHB格式\" & DD & ".NHB"
            SHFileOp.fFlags = FOF_NOCONFIRMMKDIR
            Call SHFileOperation(SHFileOp)
            MsgBox "" & App.Path & "\EXCEL生成NHB格式\" & DD & ".NHB", 64, "数据成功保存在"
            MousePointer = vbDefault

            Unload Me
        Case Else
            Cancel = True
    End Select
End Sub
Private Sub Command8_Click()
    On Error Resume Next
    Randomize
    Text1 = Int((100 * Rnd) + 1)
    Dim r As Long, RR As Long
    For r = 5 To VSFlexGrid1.Cols
        For RR = 1 To VSFlexGrid1.Rows - 1
            VSFlexGrid1.TextMatrix(RR, r) = Format((100 * Rnd) + 0.1, "00.0")
            VSFlexGrid1.TextMatrix(RR, 3) = Int((999 * Rnd) + 1)
            VSFlexGrid1.TextMatrix(RR, 1) = RR
            VSFlexGrid1.TextMatrix(RR, 2) = Int((8 * Rnd) + 1)
        Next
    Next
    Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    db.Execute "UPDATE 学生 SET 学籍=TRUE"
    db.Close
End Sub
Private Sub Form_Activate()
    On Error Resume Next
    MAIN.Enabled = False
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='输入显示'")
    XS = rs![代码]
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("SELECT * FROM 年级")
    GYXEOV = rs![班级数]
    '以下代码将取出COM中的输入显示中的代码信息,供下表格输入
    Data1.DatabaseName = App.Path & "\TEMP\" & DD & ".NHB"
    Data1.RecordSource = XS
    Data1.Refresh
    Combo1.Clear
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("班级")
    rs.MoveLast
    intRecCount = rs.RecordCount
    rs.MoveFirst
    For intCounter = 1 To intRecCount
        Combo1.AddItem rs![班级]
        rs.MoveNext
    Next intCounter
    Combo1.ListIndex = 0
    Combo3.ListIndex = 0
    '载入班级数目
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("科目")
    rs.MoveLast
    intRecCount = rs.RecordCount
    rs.MoveFirst
    For intCounter = 1 To intRecCount
        Combo2.AddItem rs![科目]
        rs.MoveNext
    Next intCounter
    Combo2.ListIndex = 2
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    Set rs = db.OpenRecordset("学生")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext                     '得到数据库中的总数目
    Loop
    Call Command1_Click
End Sub
Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    Skin1.LoadSkin App.Path & "\SKIN\5.sk"
    Skin1.ApplySkin Me.hwnd
    Me.Caption = DD
    Dim intCounter As Long
    For intCounter = 1 To 500
        Combo3.AddItem intCounter
    Next intCounter
    Combo3.ListIndex = 0
    DoEvents
    Call Command3_Click
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Resize()
    On Error Resume Next
    VSFlexGrid1.Height = Me.Height - Toolbar1.Height - 540
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 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 = 2 Then '固定检查第三列数据
        If Val(VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 2)) > GYXEOV Then
            MsgBox "输入班级数不能大于 " & GYXEOV & "", 32, "无法保存"
            VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), 2) = ""
        End If
    End If             '班级输入限制
    '##########################################################3
    If VSFlexGrid1.Col > 4 Then
        If Val(VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), VSFlexGrid1.Col)) > iawv Then
            MsgBox " " & Text1.Text & " 输入分数不能大于 " & iawv & " ", 32, "无法保存"
            VSFlexGrid1.TextMatrix(Val(VSFlexGrid1.Row), VSFlexGrid1.Col) = ""
        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 = 2 Or 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
End Sub
Private Sub VSFlexGrid1_RowColChange()
    On Error Resume Next
    If VSFlexGrid1.Col > 4 Then
        Text1.Text = VSFlexGrid1.TextMatrix(0, VSFlexGrid1.Col)
        Set db = OpenDatabase(App.Path & "\SET.PAS")
        Set rs = db.OpenRecordset("SELECT * FROM 科目 WHERE 科目='" & Text1.Text & "'")
        iawv = rs![卷面满分]
        Text2.Text = iawv
    Else
        Text1.Text = ""
        Text2.Text = ""
    End If
End Sub