form2.frm

学校考试成绩分析系统源码

    AdoFIXGrid.RecordSource = "SELECT [" & List1.Text & "] FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "' AND [" & List1.Text & "] NOT IN ('/')"
    AdoFIXGrid.Refresh
    CountStudents(RowE) = AdoFIXGrid.Recordset.RecordCount
    .Text = CountStudents(RowE)
    DoEvents
    '========================================================
    '标准分  +++ 承接以上“与考人数”数据集
    .Col = 4
    Dim Bzf1, CountFenChaZhi '（个人分数-班级平均分数）平方 后的集合
    CountFenChaZhi = 0
    AdoFIXGrid.Recordset.MoveFirst
    For Bzf1 = 0 To AdoFIXGrid.Recordset.RecordCount - 1
    '===== 计算标准分
        CountFenChaZhi = CountFenChaZhi + Round((AdoFIXGrid.Recordset.Fields(0).Value - AVGfenshu(RowE))) ^ 2
        AdoFIXGrid.Recordset.MoveNext
    Next Bzf1
    BZFenshu(RowE) = Round((CountFenChaZhi / CountStudents(RowE)) ^ (1 / 2), 2)  '该数据是计算Z分数的依据
    .Text = BZFenshu(RowE)
    '========================================================
    .Col = 6     '"优秀人数"
     AdoFIXGrid.RecordSource = "SELECT ID FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "' and [" & List1.Text & "] >='" & Trim(TextSET(0)) & "'" '优秀
     AdoFIXGrid.Refresh
     YouXiuS(RowE) = AdoFIXGrid.Recordset.RecordCount
    .Text = CStr(YouXiuS(RowE))
    '========================================================
    .Col = 7     '"优秀率"
    .Text = Format(AdoFIXGrid.Recordset.RecordCount / CountStudents(RowE) * 100, "0.00")
    '========================================================
    .Col = 8    '及格人数
     AdoFIXGrid.RecordSource = "SELECT ID FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "' and [" & List1.Text & "] >='" & Trim(TextSET(1)) & "'"  '及格总数
     AdoFIXGrid.Refresh
     JiGeS(RowE) = AdoFIXGrid.Recordset.RecordCount
    .Text = CStr(JiGeS(RowE))
    '========================================================
    .Col = 9     '及格率(人数/总数  % )
    .Text = Format(AdoFIXGrid.Recordset.RecordCount / CountStudents(RowE) * 100, "0.00")
    '========================================================
    .Col = 10     '差生人数"
     AdoFIXGrid.RecordSource = "SELECT ID FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "' and [" & List1.Text & "] <'" & Trim(TextSET(2)) & "'" & " and [" & List1.Text & "] >='0'"  '差生
     AdoFIXGrid.Refresh
     ChaShengS(RowE) = AdoFIXGrid.Recordset.RecordCount
    .Text = CStr(ChaShengS(RowE))
    '========================================================
    .Col = 11     '差生率"
    .Text = Format(AdoFIXGrid.Recordset.RecordCount / CountStudents(RowE) * 100, "0.00")
    '========================================================
    .Col = 12     '最高分"
     AdoFIXGrid.RecordSource = "SELECT MAX([" & List1.Text & "]) FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "'"  'MAX FENSHU
     AdoFIXGrid.Refresh
     If CDbl(NJMaxFS) < CDbl(AdoFIXGrid.Recordset.Fields(0).Value) Then NJMaxFS = AdoFIXGrid.Recordset.Fields(0).Value
    .Text = CStr(AdoFIXGrid.Recordset.Fields(0).Value)
    '========================================================
    .Col = 13     '最低分"
     AdoFIXGrid.RecordSource = "SELECT MIN([" & List1.Text & "]) FROM 成绩 WHERE 年级 LIKE '" & Left(ListHZ.List(RowE - 1), 4) & "' AND 班级 LIKE '" & Right(ListHZ.List(RowE - 1), 3) & "'" & " and [" & List1.Text & "] >='0'"  'MIN FENSHU
     AdoFIXGrid.Refresh
     If CDbl(NJMinFS) > CDbl(AdoFIXGrid.Recordset.Fields(0).Value) Then NJMinFS = AdoFIXGrid.Recordset.Fields(0).Value
    .Text = CStr(AdoFIXGrid.Recordset.Fields(0).Value)
DoEvents
Next RowE


.Row = RowE + 1 '===========统计行

.Col = 0: .Text = "年  级"
.Col = 2
    Dim I2, NJ2
    NJ2 = 0
    For I2 = 1 To ListHZ.ListCount
     NJ2 = NJ2 + CountStudents(I2)
    Next I2
    .Text = NJ2
.Col = 3
    Dim I3, NJ3
    NJ3 = 0
    For I3 = 1 To ListHZ.ListCount
     NJ3 = NJ3 + AVGfenshu(I3)
    Next I3
    AVGNj = Round(NJ3 / ListHZ.ListCount, 2)
    .Text = AVGNj
.Col = 4
    Dim I4, NJ4
    NJ4 = 0
    For I4 = 1 To ListHZ.ListCount
     NJ4 = NJ4 + BZFenshu(I4)
    Next I4
    .Text = Round(NJ4 / ListHZ.ListCount, 2)
.Col = 6
    Dim I6, NJ6
    NJ6 = 0
    For I6 = 1 To ListHZ.ListCount
     NJ6 = NJ6 + YouXiuS(I6)
    Next I6
    .Text = NJ6
.Col = 7
    Dim I7, NJ7
    NJ7 = 0
    For I7 = 1 To ListHZ.ListCount
    .Row = I7
     NJ7 = NJ7 + CDbl(.Text)
    Next I7
    .Row = RowE + 1
    .Text = Format(NJ7 / ListHZ.ListCount, "0.00")
.Col = 8
    Dim I8, NJ8
    NJ8 = 0
    For I8 = 1 To ListHZ.ListCount
     NJ8 = NJ8 + JiGeS(I8)
    Next I8
    .Text = NJ8
.Col = 9
    Dim I9, NJ9
    NJ9 = 0
    For I9 = 1 To ListHZ.ListCount
    .Row = I9
     NJ9 = NJ9 + CDbl(.Text)
    Next I9
    .Row = RowE + 1
    .Text = Format(NJ9 / ListHZ.ListCount, "0.00")
.Col = 10
    Dim I10, NJ10
    NJ10 = 0
    For I10 = 1 To ListHZ.ListCount
     NJ10 = NJ10 + ChaShengS(I10)
    Next I10
    .Text = NJ10
.Col = 11
    Dim I11, NJ11
    NJ11 = 0
    For I11 = 1 To ListHZ.ListCount
    .Row = I11
     NJ11 = NJ11 + CDbl(.Text)
    Next I11
    .Row = RowE + 1
    .Text = Format(NJ11 / ListHZ.ListCount, "0.00")
.Col = 12: .Text = NJMaxFS
.Col = 13: .Text = NJMinFS
    
' ========================================================
 .Col = 5     '"Z分数"
 
 Dim I_ZF
    For I_ZF = 1 To ListHZ.ListCount
    .Row = I_ZF
       If (AVGfenshu(I_ZF) - AVGNj) / BZFenshu(I_ZF) = 0 Then
         .Text = "0"
        Else
         .Text = Format((AVGfenshu(I_ZF) - AVGNj) / BZFenshu(I_ZF), "0.00")
       End If
    Next I_ZF

.Row = 0
.Col = 0
End With
Debug.Print " 结束： " & Now
Form2EnableSet True
Screen.MousePointer = 0
End Sub

Private Sub Cmmond2EXCEL_Click()  '************************* 输出到EXCEL
On Error Resume Next
Screen.MousePointer = 11
Dim xlsApp As Excel.Application
Dim xlsWK As Excel.Workbook
Dim xlsSHEET As Excel.Worksheet
Set xlsApp = CreateObject("Excel.Application")
Set xlsWK = xlsApp.Workbooks.Add
Set xlsSHEET = xlsWK.Sheets(1) '=======================
DoEvents
Screen.MousePointer = 0

MSFlexGrid结果.Visible = False
Dim I, J, AR(29, 29)
For I = 0 To 29
 Screen.MousePointer = 11
 For J = 0 To 29
 MSFlexGrid结果.Col = I
 MSFlexGrid结果.Row = J
 AR(J, I) = MSFlexGrid结果.Text
 Next J
Screen.MousePointer = 0
Next I
MSFlexGrid结果.Visible = True
DoEvents
'============================================
xlsSHEET.Cells(1, 1) = List1.Text & " 成绩分析"
xlsSHEET.Cells(39, 1) = "青岛市商业中专 " & Format(Now(), " 日期:YYYY年MM月DD日")
'======================================================================
With xlsSHEET.Range("A1:N1")    '报表表头设置
.MergeCells = True
.HorizontalAlignment = xlCenter
.Font.Size = 12
End With
DoEvents
With xlsSHEET.Range("A39:N39")   '报表日期设置
.MergeCells = True
.HorizontalAlignment = xlRight
End With


'===========================================!!!!!! 获得数据集合数组


'==============================设置EXCEL格式
xlsSHEET.Rows("1:32").RowHeight = 18
xlsSHEET.Rows("3:42").Font.Size = 10
Screen.MousePointer = 11

With xlsSHEET.Range("A3:N3")
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
Screen.MousePointer = 11
DoEvents
Screen.MousePointer = 0
xlsSHEET.Range("A4:N32").HorizontalAlignment = xlRight '表体右排列
xlsSHEET.Range("A4:N32").VerticalAlignment = xlBottom

xlsSHEET.Range("A3:N32").Value = AR
xlsSHEET.Columns("A:N").AutoFit

Screen.MousePointer = 11
'======================
DoEvents
With xlsSHEET.PageSetup
    .CenterHorizontally = True  '打印 水平居中
    .PaperSize = xlPaperA4      'A4打印纸
    .Orientation = xlPortrait   '竖向放置
    .LeftMargin = Application.InchesToPoints(0.15748031496063)
    .RightMargin = Application.InchesToPoints(0.15748031496063)
End With

Screen.MousePointer = 0
DoEvents


xlsApp.Visible = True
DoEvents
End Sub

Private Sub Form_Activate()
Me.Caption = Me.Caption & "  青岛市商业中专"
End Sub

Private Sub Form_Load()
Command刷新科目列表_Click
End Sub

Private Sub List1_Click()
On Error Resume Next
Screen.MousePointer = 13
If List1.SelCount <> 0 Then
    ListHZ.Clear
    If List2.ListCount <> 0 Then List2.Clear
    Dim I, J
    AdoNJ.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
    AdoBJ.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
    
    AdoNJ.RecordSource = "SELECT DISTINCT 年级 FROM 成绩 ORDER BY 年级"
    AdoNJ.Refresh
    AdoNJ.Recordset.MoveFirst
    For I = 1 To AdoNJ.Recordset.RecordCount
          AdoBJ.RecordSource = "SELECT DISTINCT 班级 FROM 成绩 WHERE 年级 = '" & AdoNJ.Recordset.Fields(0).Value & "' and [" & List1.Text & "] NOT LIKE '/' ORDER BY 班级"
          AdoBJ.Refresh
            For J = 1 To AdoBJ.Recordset.RecordCount
                
                List2.AddItem AdoNJ.Recordset.Fields(0).Value & AdoBJ.Recordset.Fields(0).Value
                AdoBJ.Recordset.MoveNext
            Next J
          AdoNJ.Recordset.MoveNext
    Next I

Me.Caption = List1.Text & " " & Me.Caption
End If

Screen.MousePointer = 0
End Sub
Private Sub List2_DblClick()

ListHZ.AddItem List2.Text
End Sub
Private Sub ListHZ_DblClick()
ListHZ.RemoveItem ListHZ.ListIndex

End Sub

Private Sub TextSET_GotFocus(Index As Integer)
TextSET(Index).SelStart = 0
TextSET(Index).SelLength = 50
End Sub

Private Sub TextSET_KeyPress(Index As Integer, KeyAscii As Integer)
   If InStr("0123456789." + vbBack, Chr(KeyAscii)) = 0 Then
      KeyAscii = 0
      Exit Sub
   End If
End Sub

Private Sub TextSET_LostFocus(Index As Integer)
If IsNumeric(TextSET(Index).Text) = True Then
TextSET(Index).Text = Trim(TextSET(Index).Text)
Else
 MsgBox "格式错误，请重新输入并确保其为数字格式！", vbCritical, "错误"
 TextSET(Index).SetFocus
End If
End Sub

Public Sub Form2EnableSet(Bln As Boolean)
Dim obj
For Each obj In Form2
 If obj.Name <> "Frame1" Then obj.Enabled = Bln
Next
End Sub