www.pudn.com > vb71053453673553.rar > Form2.frm
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{4406B9AC-521E-476B-AF25-3D2C36110576}#3.0#0"; "CommandSCE.ocx"
Begin VB.Form Form2
BorderStyle = 1 'Fixed Single
Caption = "成绩分析"
ClientHeight = 6795
ClientLeft = 45
ClientTop = 435
ClientWidth = 9945
Icon = "Form2.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6795
ScaleWidth = 9945
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "参数设置"
Enabled = 0 'False
Height = 1515
Left = 6870
TabIndex = 13
Top = 90
Width = 2685
Begin VB.TextBox TextSET
Enabled = 0 'False
Height = 285
Index = 2
Left = 1440
TabIndex = 16
TabStop = 0 'False
Text = "60"
Top = 1050
Width = 735
End
Begin VB.TextBox TextSET
Enabled = 0 'False
Height = 285
Index = 1
Left = 1440
TabIndex = 15
TabStop = 0 'False
Text = "60"
Top = 690
Width = 735
End
Begin VB.TextBox TextSET
Enabled = 0 'False
Height = 285
Index = 0
Left = 1440
TabIndex = 14
TabStop = 0 'False
Text = "90"
Top = 330
Width = 735
End
Begin VB.Label Label6
Caption = "差生分数：<="
Enabled = 0 'False
Height = 315
Left = 120
TabIndex = 22
Top = 1080
Width = 1215
End
Begin VB.Label Label5
Caption = "及格分数：>="
Enabled = 0 'False
Height = 315
Left = 120
TabIndex = 21
Top = 720
Width = 1215
End
Begin VB.Label Label4
Caption = "优秀分数：>="
Enabled = 0 'False
Height = 315
Left = 120
TabIndex = 20
Top = 360
Width = 1215
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "分"
Enabled = 0 'False
Height = 180
Left = 2250
TabIndex = 19
Top = 1110
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "分"
Enabled = 0 'False
Height = 180
Left = 2250
TabIndex = 18
Top = 750
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "分"
Enabled = 0 'False
Height = 180
Left = 2250
TabIndex = 17
Top = 390
Width = 180
End
End
Begin CSCommandSCE.CommandSCE CommandSCE修改参数
Height = 345
Left = 8310
TabIndex = 12
Top = 1740
Width = 1245
_ExtentX = 2196
_ExtentY = 609
Icon = "Form2.frx":058A
Caption = "修改参数"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ShowFocus = 0 'False
Appearance = 2
End
Begin MSAdodcLib.Adodc AdoHZ
Height = 330
Left = 210
Top = 1290
Visible = 0 'False
Width = 1755
_ExtentX = 3096
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "AdoHZ"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin CSCommandSCE.CommandSCE CommandOUT
Height = 555
Left = 4380
TabIndex = 11
Top = 1590
Width = 285
_ExtentX = 503
_ExtentY = 979
IconAlign = 0
Icon = "Form2.frx":0B24
Caption = "《 "
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommandSCE.CommandSCE CommandIN
Height = 585
Left = 4380
TabIndex = 10
Top = 630
Width = 285
_ExtentX = 503
_ExtentY = 1032
IconAlign = 0
Icon = "Form2.frx":0B40
Caption = " 》"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSAdodcLib.Adodc AdoBJ
Height = 330
Left = 2880
Top = 2280
Visible = 0 'False
Width = 1770
_ExtentX = 3122
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "AdoBJ"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc AdoNJ
Height = 330
Left = 2460
Top = 1950
Visible = 0 'False
Width = 1785
_ExtentX = 3149
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "AdoNJ"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.ListBox List2
Height = 2220
Left = 2580
TabIndex = 6
Top = 360
Width = 1725
End
Begin VB.ListBox List1
Height = 2220
Left = 150
TabIndex = 5
Top = 360
Width = 1785
End
Begin VB.ListBox ListHZ
Height = 2220
Left = 4710
TabIndex = 0
Top = 360
Width = 1785
End
Begin MSAdodcLib.Adodc AdoFIXGrid
Height = 330
Left = 3150
Top = 4530
Visible = 0 'False
Width = 2385
_ExtentX = 4207
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "AdoFIXGrid"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid结果
Height = 4095
Left = 0
TabIndex = 1
Top = 2670
Width = 9945
_ExtentX = 17542
_ExtentY = 7223
_Version = 393216
Rows = 30
Cols = 30
FixedCols = 0
AllowBigSelection= 0 'False
FocusRect = 0
GridLinesFixed = 1
AllowUserResizing= 1
End
Begin CSCommandSCE.CommandSCE Cmmond2EXCEL
Height = 345
Left = 8310
TabIndex = 2
Top = 2220
Width = 1245
_ExtentX = 2196
_ExtentY = 609
Icon = "Form2.frx":0B5C
Caption = "输出结果"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ShowFocus = 0 'False
Appearance = 2
End
Begin CSCommandSCE.CommandSCE Command计算分析
Height = 345
Left = 6900
TabIndex = 3
Top = 2220
Width = 1245
_ExtentX = 2196
_ExtentY = 609
Icon = "Form2.frx":10F6
Caption = "计算分析"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ShowFocus = 0 'False
Appearance = 2
End
Begin CSCommandSCE.CommandSCE Command刷新科目列表
Height = 345
Left = 6900
TabIndex = 4
Top = 1740
Width = 1245
_ExtentX = 2196
_ExtentY = 609
Icon = "Form2.frx":1690
Caption = "刷新科目"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ShowFocus = 0 'False
Appearance = 2
End
Begin VB.Label Lab9
Caption = "参与当前考试的班级:"
Height = 255
Left = 2580
TabIndex = 9
Top = 90
Width = 1815
End
Begin VB.Label Lab10
Caption = "本考试中涉及的科目:"
Height = 255
Left = 180
TabIndex = 8
Top = 90
Width = 1845
End
Begin VB.Label Lab16
Caption = "欲参与汇总的班级："
ForeColor = &H80000007&
Height = 285
Left = 4710
TabIndex = 7
Top = 90
Width = 1755
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CommandIN_Click()
Dim I
For I = 0 To List2.ListCount - 1
ListHZ.AddItem List2.List(I)
Next I
End Sub
Private Sub CommandOUT_Click()
ListHZ.Clear
End Sub
Private Sub CommandSCE修改参数_Click()
If CommandSCE修改参数.Caption = "修改参数" Then
CommandSCE修改参数.Caption = "保存参数"
Command计算分析.Enabled = False
Cmmond2EXCEL.Enabled = False
Frame1.Enabled = True
TextSET(0).Enabled = True
TextSET(1).Enabled = True
TextSET(2).Enabled = True
Label1.Enabled = True
Label2.Enabled = True
Label3.Enabled = True
Label4.Enabled = True
Label5.Enabled = True
Label6.Enabled = True
Else
CommandSCE修改参数.Caption = "修改参数"
Command计算分析.Enabled = True
Cmmond2EXCEL.Enabled = True
Frame1.Enabled = False
TextSET(0).Enabled = False
TextSET(1).Enabled = False
TextSET(2).Enabled = False
Label1.Enabled = False
Label2.Enabled = False
Label3.Enabled = False
Label4.Enabled = False
Label5.Enabled = False
Label6.Enabled = False
End If
End Sub
Private Sub Command刷新科目列表_Click() '计算输出界面使用=======================
AdoHZ.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
AdoHZ.RecordSource = "SELECT TOP 1 * FROM 成绩"
AdoHZ.Refresh
Dim I
If List1.ListCount <> 0 Then List1.Clear
For I = 5 To AdoHZ.Recordset.Fields.Count - 1
List1.AddItem Trim(AdoHZ.Recordset.Fields(I).Name)
Next
List2.Clear
ListHZ.Clear
End Sub
'===============================================
' 计算调用
Private Sub Command计算分析_Click()
If ListHZ.ListCount = 0 Then Exit Sub
If ListHZ.ListCount > 25 Then
MsgBox "本程序只提供最大对25个班级进行计算分析？请调整选择！", vbCritical + vbOKOnly, "超范围"
Exit Sub
End If
'If MsgBox("确定进行计算分析？", vbQuestion + vbOKCancel, "确认") = vbCancel Then Exit Sub
'
On Error Resume Next
Screen.MousePointer = 11
Form2EnableSet False
'预定义函数如下
Dim CountZF '班级Z分数
Dim CountStudents(29) As Integer '学生人数
Dim AVGfenshu(29) '平均分数
Dim AVGNj '年级平均分
Dim BZFenshu(29) '标准分数
Dim YouXiuS(29), JiGeS(29), ChaShengS(29)
Dim NJMaxFS, NJMinFS
CountZF = 0
NJMaxFS = 0
NJMinFS = 1000
Dim RowE
AdoFIXGrid.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
With MSFlexGrid结果
.Clear
'===================== 重新设置表头
.Row = 0
.Col = 0: .Text = "班级"
.Col = 1: .Text = "教师"
.Col = 2: .Text = "与考"
.Col = 3: .Text = "平均分"
.Col = 4: .Text = "标准分"
.Col = 5: .Text = "Z分数"
.Col = 6: .Text = "优秀数"
.Col = 7: .Text = "优秀率%"
.Col = 8: .Text = "及格数"
.Col = 9: .Text = "及格率%"
.Col = 10: .Text = "差生数"
.Col = 11: .Text = "差生率%"
.Col = 12: .Text = "最高分"
.Col = 13: .Text = "最低分"
'================================================================= *******
For RowE = 1 To ListHZ.ListCount '开始(留表头空间)
.Row = RowE
'======== 班级
.Col = 0
.Text = ListHZ.List(RowE - 1)
'========================================================
.Col = 3 '平均分
AdoFIXGrid.RecordSource = "SELECT AVG([" & 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
AVGfenshu(RowE) = Round(AdoFIXGrid.Recordset.Fields(0).Value, 2)
.Text = AVGfenshu(RowE)
'========================================================
.Col = 2 '与考人数
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