main.frm

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

    On Error Resume Next

    Me.Enabled = False
    FRMksmc.Show
End Sub
Private Sub KSLXBG_Click()
    On Error Resume Next

    Me.Enabled = False
    FrmKSBG.Show
End Sub
Private Sub KSLXHY_Click()
    On Error Resume Next

    Me.Enabled = False
    Frmkshy.Show
End Sub
Private Sub KZFP_Click()
    On Error Resume Next

    Me.Enabled = False
    KCAUTO.Show
End Sub
Private Sub LAOD_Click()
    Me.Enabled = False
    CMD2.filename = ""
    CMD2.CancelError = True
    On Error GoTo 32755
    CMD2.Flags = cdlOFNHideReadOnly
    CMD2.InitDir = App.Path
    CMD2.Filter = "NHB数据文件(*.NHB)|*.NHB|"
    CMD2.FilterIndex = 2
    CMD2.ShowOpen
    DoEvents
    Set db = OpenDatabase(MAIN.CMD2.filename)
    Set rs = db.OpenRecordset("SELECT MAX(班级) FROM 学生")
    BJS = Format$(rs(0))
    db.Close
    '
    Set db = OpenDatabase(MAIN.CMD2.filename)
    db.Execute "UPDATE 年级 SET 班级数='" & BJS & "' "
    db.Close
    Set db = Nothing
    Set db = OpenDatabase(MAIN.CMD2.filename)
    STR = "DELETE * from [班级]"
    db.Execute STR
    db.Close
    Dim BJTJ As Long
    For BJTY = 1 To BJS
        Set db = OpenDatabase(MAIN.CMD2.filename)
        STR = "INSERT INTO 班级 (班级) VALUES ( '" & BJTY & "')"
        db.Execute STR
        db.Close
    Next BJTY
    DoEvents
    frmStart.Show
32755:
    Select Case Err.Number
        Case 3343
            MsgBox "无法识别的NHB数据文件,或者该文件已损坏", 64, "无法载入"
            MAIN.CMD2.filename = ""
            MAIN.Enabled = True
            Exit Sub
        Case 3061
            MsgBox "此数据被破坏,请使用数据恢复来修复此数据库", 32, "无法载入"
            MAIN.CMD2.filename = ""
            MAIN.Enabled = True
            Exit Sub
        Case 3078
            MsgBox "此数据格式不对或被破坏", 32, "无法载入"
            MAIN.CMD2.filename = ""
            MAIN.Enabled = True
            Exit Sub
        Case 13
            MsgBox "数据库有误,如:某个班级分数未输入完整", 64, "无法载入"
            MAIN.CMD2.filename = ""
            MAIN.Enabled = True
            Exit Sub
        Case 32755:
            MAIN.CMD2.filename = ""
            MAIN.Enabled = True
            Exit Sub
    End Select
End Sub

Private Sub MA_Click()
    On Error Resume Next
    Call LAOD_Click
End Sub

Private Sub MEB_Click()
    On Error Resume Next
    Call EDIT_Click
End Sub

Private Sub MEC_Click()
    On Error Resume Next
    Call NEW_Click
End Sub

Private Sub mesg_Click()
    On Error Resume Next

    Call XSMC_Click
End Sub

Private Sub MEUZHASD_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        MousePointer = vbHourglass
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "班级综合分析表.XLS"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT * INTO [Excel 8.0;DATABASE=C:\" & nmc & "班级综合分析表.XLS].[" & nmc & "班级综合分析表] FROM  [班主任] "
        db.Close
        MousePointer = vbDefault
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "班级综合分析表.XLS", "", "", SW_SHOW)
    End If
End Sub
Private Sub MNUEC_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        MousePointer = vbHourglass
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "三项之和分析表.XLS"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT * INTO [Excel 8.0;DATABASE=C:\" & nmc & "三项之和分析表.XLS].[" & nmc & "三项之和分析表] FROM  [分析表] "
        db.Close
        MousePointer = vbDefault
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "三项之和分析表.XLS", "", "", SW_SHOW)
    End If
End Sub
Private Sub MYSE_Click()
    On Error Resume Next

    Me.Enabled = False
    frmshbb1.Show
End Sub
Private Sub MYSELF_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSHBB4.Show
End Sub
Private Sub MZBST_Click()
    On Error Resume Next

    Me.Enabled = False
    MSD.Show
End Sub
Private Sub NEW_Click()
    On Error Resume Next
    SHFileOp.wFunc = FO_DELETE
    SHFileOp.pFrom = App.Path & "\TEMP\*.*"
    SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION + FOF_SILENT
    Call SHFileOperation(SHFileOp)
    Me.Enabled = False
    FrmNEW.Show
End Sub
Private Sub NJLX_Click()
    MAIN.Enabled = False
    On Error Resume Next

    FRMnjsz.Show
End Sub
Private Sub NJXF_Click()
    On Error Resume Next

    Me.Enabled = False
    NXF.Show
End Sub
Private Sub NJXM_Click()
    On Error Resume Next

    Me.Enabled = False
    NXN.Show
End Sub
Private Sub OPEA_Click()
    On Error Resume Next
    '        MsgBox "此程序演示版,视频文件在正式版中提供", 64, "对不起"
    Dim r As Long
    r = StartDoc(App.Path & "\系统颜色提取全面参数.exe")

End Sub
Private Sub OPHE_Click()
    On Error Resume Next
    Dim r As Long
    r = StartDoc(App.Path & "\学分统计系统帮助.chm")
    'MsgBox "非注册用户不能提供帮助文件", 64, "对不起"
End Sub
Private Sub OPLA_Click()
    On Error Resume Next
    '        MsgBox "此程序演示版,视频文件在正式版中提供", 64, "对不起"
    Dim r As Long
    r = StartDoc(App.Path & "\播放器.exe")
End Sub

Private Sub pyglst_Click()
    On Error Resume Next

    Me.Enabled = False
    PMAIN.Show
End Sub

Private Sub RASDFGT_Click()
    On Error Resume Next

    MAIN.Enabled = False
    FRMAUTOFB.Show
End Sub
Private Sub REG_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMreg2.Show
End Sub

Private Sub ryusj_Click()
    On Error Resume Next

    Call TU45634_Click
End Sub

Private Sub SAVE_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMzBF.Show
End Sub
Private Sub SCHOOL_Click()
    On Error Resume Next

    Me.Enabled = False
    Frmschname.Show
End Sub
Private Sub SDFGET34_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMALLMZB.Show
End Sub
Private Sub serye4_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMmyselt.Show
End Sub
Private Sub SKN1_Click(index As Integer)
    Dim i As Long
    For i = 0 To SKN1.Count - 1
        SKN1(i).Checked = False
    Next
    successa = WritePrivateProfileString("Message to Display", "Message", "" & index & "", App.Path & "\skin\skin.ini")
    SKN1(index).Checked = 1
    Skin1.LoadSkin App.Path & "\SKIN\" & index & ".sk"
    Skin1.ApplySkin Me.hwnd

End Sub
Private Sub SXJHDATA_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "三项之和分析表.HTM"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT * INTO [HTML Export;DATABASE=C:\ ].[" & nmc & "三项之和分析表.HTM] FROM  [分析表] "
        db.Close
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "三项之和分析表.HTM", "", "", SW_SHOW)
    End If
End Sub
Private Sub SXZH_Click()
    On Error Resume Next

    Me.Enabled = False
    frmsxh.Show
End Sub
Private Sub SXZHBB_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSHBB.Show
End Sub
Private Sub SXZHBBA_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSHBB2.Show
End Sub
Private Sub SXZHBBAA_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSHBB3.Show
End Sub
Private Sub TERTERT5_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMALLBNAME.Show
End Sub

'Private Sub Timer1_Timer()
'SkinLabel1.Visible = False
'SkinLabel2.Visible = False
'SkinLabel3.Visible = False
'SkinLabel4.Visible = False
'End Sub

Private Sub TKBJX_Click()
    On Error Resume Next

    Me.Enabled = False
    DBX.Show
End Sub
Private Sub TKNJX_Click()
    On Error Resume Next

    Me.Enabled = False
    DNX.Show
End Sub
Private Sub TOOL2_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMFSBG.Show
End Sub
Private Sub TOOL3_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMfstxb.Show
End Sub
Private Sub TU45634_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSCAEEN.Show
End Sub
Private Sub WETR_Click()
    On Error Resume Next

    Me.Enabled = False
    frmdkbb2.Show
End Sub
Private Sub XSMC_Click()
    On Error Resume Next

    Me.Enabled = False
    FrmRmc.Show
End Sub