frmexcelzh1.frm

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

VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Begin VB.Form FRMEXCELZH1 
   Caption         =   "Form1"
   ClientHeight    =   2280
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5670
   Icon            =   "FRMEXCELZH1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2280
   ScaleWidth      =   5670
   StartUpPosition =   2  '屏幕中心
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access 2000;"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   8700
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   8370
      Width           =   1185
   End
   Begin VB.CommandButton Command5 
      Caption         =   "下一步"
      Height          =   495
      Left            =   4440
      TabIndex        =   4
      Top             =   1380
      Width           =   1155
   End
   Begin VB.ListBox List1 
      ForeColor       =   &H00D41700&
      Height          =   1530
      Left            =   90
      Style           =   1  'Checkbox
      TabIndex        =   3
      Top             =   120
      Width           =   4245
   End
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   7050
      Top             =   1410
   End
   Begin VB.Timer Timer2 
      Interval        =   1
      Left            =   4650
      Top             =   150
   End
   Begin VB.TextBox Text1 
      Height          =   2115
      Left            =   270
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Text            =   "FRMEXCELZH1.frx":1272
      Top             =   2670
      Width           =   5235
   End
   Begin VB.Timer Timer3 
      Interval        =   1
      Left            =   8070
      Top             =   1740
   End
   Begin VB.Timer Timer4 
      Interval        =   1
      Left            =   8970
      Top             =   1710
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   855
      Left            =   3450
      TabIndex        =   1
      Top             =   5370
      Width           =   765
   End
   Begin VB.Timer Timer5 
      Interval        =   1
      Left            =   810
      Top             =   5550
   End
   Begin VB.TextBox Text2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1185
      Left            =   150
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "FRMEXCELZH1.frx":1278
      Top             =   6360
      Width           =   8835
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   4500
      OleObjectBlob   =   "FRMEXCELZH1.frx":127E
      Top             =   720
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   225
      Left            =   450
      OleObjectBlob   =   "FRMEXCELZH1.frx":4B76D
      TabIndex        =   5
      Top             =   1950
      Width           =   3495
   End
End
Attribute VB_Name = "FRMEXCELZH1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim STR As String
Dim NUM As Long
Dim tuhh As String '自动添加所有科目及科目年级与班级名次表格
Dim LWJO As String '显示所有科目内容,将它保存在COM中,之后在数据输入时表格显示代码
Dim LOADDATA As String '产生载入数据时所需要的代码
Dim MAINFS As String
Dim FSBB As String '产生分数报表输出代码
Dim SUMFX As String
Dim M1 As String
Dim MM1 As String

Private Sub Command2_Click()
    On Error Resume Next
    Set db = OpenDatabase(App.Path & "\SET.PAS")
    Set rs = db.OpenRecordset(SUMFX)
    Text2 = Format$(rs(0))
    db.Close
End Sub
Private Sub Command5_Click()
    On Error GoTo 3292
    MousePointer = vbHourglass
    '根选择的科目,进行数据自动添加于原始表中
    Dim astr As String
    Dim dbAdd As Database
    Screen.MousePointer = vbHourglass
    Set dbAdd = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    astr = tuhh
    dbAdd.Execute astr
    Screen.MousePointer = vbDefault
    dbAdd.Close
    Set dbAdd = Nothing
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('输入显示','" & LWJO & "')"
    db.Execute STR
    db.Close
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('分数输出','" & FSBB & "')"
    db.Execute STR
    db.Close
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('载入数据','" & LOADDATA & "')"
    db.Execute STR
    db.Close
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('M1','" & M1 & "')"
    db.Execute STR
    db.Close
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('MM1','" & MM1 & "')"
    db.Execute STR
    db.Close
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('合计总分','" & MAINFS & "')"
    db.Execute STR
    db.Close
    Call Command2_Click
    Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
    STR = "INSERT INTO COM (标记,代码) VALUES ('总分','" & Text2.Text & "')"
    db.Execute STR
    db.Close
    '''###################################################################################
    Dim i As Integer, lb(200) As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
            STR = "INSERT INTO 科目 (科目) VALUES ('" & List1.List(i) & "')"
            db.Execute STR
            db.Close
            Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
            STR = "INSERT INTO 个性 (个性) VALUES ('" & List1.List(i) & "')"
            db.Execute STR
            db.Close
            Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
            STR = "INSERT INTO 个性 (个性) VALUES ('" & List1.List(i) & "班级名次" & "')"
            db.Execute STR
            db.Close
            Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
            STR = "INSERT INTO 个性 (个性) VALUES ('" & List1.List(i) & "年级名次" & "')"
            db.Execute STR
            db.Close
        End If
    Next i               '取出当前所选科目的内容,保存在科目表中,供输入数据时,排列方式用
    '''###################################################################################
    Me.Hide
    FRMEXCELZH2.Show
    MousePointer = vbDefault
    Unload Me
3292:
    Select Case Err.Number
        Case 3292
            Screen.MousePointer = vbDefault
            MsgBox "至少选择一个科目", 32, "数据未选择"
            MousePointer = vbDefault
            Exit Sub
    End Select
End Sub
Private Sub Form_Activate()
    On Error Resume Next
    MAIN.Enabled = False
    MousePointer = vbDefault
    List1.Clear
    Set db = OpenDatabase(App.Path & "\SET.PAS")
    Set rs = db.OpenRecordset("科目")
    rs.MoveLast
    intRecCount = rs.RecordCount
    rs.MoveFirst
    For intCounter = 1 To intRecCount
        List1.AddItem rs![科目]
        rs.MoveNext
    Next intCounter
    List1.ListIndex = 0
    Set db = OpenDatabase(App.Path & "\SET.PAS")
    Set rs = db.OpenRecordset("科目")
    NUM = 0
    rs.MoveFirst
    Do While Not rs.EOF()
        NUM = NUM + 1
        rs.MoveNext
    Loop
    '以上代码将总科目数取出
End Sub
Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    MousePointer = vbDefault
    Text1.Text = ""
    '    Skin1.LoadSkin App.Path & "\SKIN\8.sk"
    Skin1.ApplySkin Me.hwnd
    Me.Caption = DD
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
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 Timer1_Timer()
    On Error Resume Next
    Dim i As Integer, lb(200) As String, sd As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            If Len(sd) <> 0 Then
                sd = sd + "," + lb(i) + " currency " + "," + lb(i) + "班级名次 LONG" + "," + lb(i) + "年级名次 LONG"
            Else
                sd = lb(i) + " currency " + "," + lb(i) + "班级名次 LONG" + "," + lb(i) + "年级名次 LONG"
            End If
        End If
    Next i
    sd = "" + sd + ""
    tuhh = "ALTER TABLE 学生 ADD COLUMN " & "" + sd + ""
End Sub
Private Sub Timer2_Timer()
    On Error Resume Next
    Dim i As Integer, lb(200) As String, sd As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            If Len(sd) <> 0 Then
                sd = sd + "," + lb(i)
            Else
                sd = lb(i)
            End If
        End If
    Next i
    sd = "" + sd + ""
    LWJO = "SELECT 学号,班级,姓名,学籍, " & "" + sd + "" & " FROM 学生"
    FSBB = "SELECT 学号,班级,姓名,学籍, " & "" + sd + "" & ",总分,总分班级名次,总分年级名次 FROM 学生"
    M1 = "学号,班级,姓名,学籍, " & "" + sd + "" & ",总分,总分班级名次,总分年级名次"
End Sub
Private Sub Timer3_Timer()
    On Error Resume Next
    Dim i As Integer, lb(200) As String, sd As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            If Len(sd) <> 0 Then
                sd = sd + "," + lb(i) + "," + lb(i) + "班级名次" + "," + lb(i) + "年级名次"
            Else
                sd = lb(i) + "," + lb(i) + "班级名次" + "," + lb(i) + "年级名次"
            End If
        End If
    Next i
    sd = "" + sd + ""
    LOADDATA = "SELECT 学号,班级,姓名,学籍, " & "" + sd + "" & ",总分,总分班级名次,总分年级名次 FROM 学生"
    MM1 = "学号,班级,姓名,学籍, " & "" + sd + "" & ",总分,总分班级名次,总分年级名次"
End Sub
Private Sub Timer4_Timer()
    On Error Resume Next
    Dim i As Integer, lb(200) As String, sd As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            If Len(sd) <> 0 Then
                sd = sd + " + " + lb(i)
            Else
                sd = lb(i)
            End If
        End If
    Next i
    sd = "" + sd + ""
    MAINFS = "UPDATE 学生 SET 总分= " & "" + sd + "" & " "
End Sub
Private Sub Timer5_Timer()
    'SELECT sum(卷面满分) FROM [科目] WHERE 科目='语文' OR 科目='数学' OR 科目='物理'")
    On Error Resume Next
    Dim i As Integer, lb(200) As String, sd As String
    For i = 0 To Val(NUM - 1)
        lb(i) = List1.List(i)
    Next i
    sd = ""
    For i = 0 To Val(NUM - 1)
        If List1.Selected(i) Then
            If Len(sd) <> 0 Then
                sd = sd + "' OR 科目='" + lb(i)
            Else
                sd = lb(i)
            End If
        End If
    Next i
    sd = "科目='" + sd + ""
    SUMFX = " SELECT sum(卷面满分) FROM [科目] WHERE " + sd + "'"
End Sub