📄 frmmark.frm
字号:
Index = 5
Left = 2010
TabIndex = 22
Top = 910
Width = 1065
End
Begin VB.CheckBox chkXQ
Caption = "第五学期"
ForeColor = &H00000000&
Height = 255
Index = 4
Left = 420
TabIndex = 21
Top = 920
Width = 1065
End
Begin VB.CheckBox chkXQ
Caption = "第四学期"
ForeColor = &H00000000&
Height = 255
Index = 3
Left = 2010
TabIndex = 20
Top = 590
Width = 1065
End
Begin VB.CheckBox chkXQ
Caption = "第三学期"
ForeColor = &H00000000&
Height = 255
Index = 2
Left = 420
TabIndex = 19
Top = 610
Width = 1065
End
Begin VB.CheckBox chkXQ
Caption = "第二学期"
ForeColor = &H00000000&
Height = 255
Index = 1
Left = 2010
TabIndex = 18
Top = 270
Width = 1065
End
Begin VB.CheckBox chkXQ
Caption = "第一学期"
ForeColor = &H00000000&
Height = 255
Index = 0
Left = 420
TabIndex = 17
Top = 300
Width = 1065
End
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H0000FF00&
BorderStyle = 1 'Fixed Single
Caption = "正在依成绩排序，请稍候……"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 270
Left = 3480
TabIndex = 32
Top = 1890
Visible = 0 'False
Width = 2790
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "平均学积分"
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 345
Left = 6810
MouseIcon = "frmMark.frx":0CD0
MousePointer = 99 'Custom
TabIndex = 30
Top = 1920
Width = 1365
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00C0C0C0&
Caption = "姓名"
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 2340
TabIndex = 27
Top = 1920
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "班级"
BeginProperty Font
Name = "幼圆"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 600
TabIndex = 26
Top = 1920
Width = 855
End
End
Attribute VB_Name = "frmMark"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim XM(0 To 50) As String
Dim mark(0 To 50) As Double
Dim ListArray(0 To 50) As String
Dim DAT As Database
Private Sub Command1_Click()
'On Error GoTo ERR
Dim QueryCount As Integer '查询记号
Dim Query(1 To 8) As String '查询条件数组
Dim K As Integer
Dim L As Integer
Dim SQLFORXM As String
txtZHF.Text = ""
If LSTBJ.Text = "" Then
MsgBox "请选择班级信息!", vbInformation, "信息提示框"
Exit Sub
End If
If lstXM.Text = "" Then
MsgBox "请选择学生姓名!", vbInformation, "信息提示框"
Exit Sub
End If
If chkXQ(0).Value = 0 And chkXQ(1).Value = 0 And chkXQ(2).Value = 0 And chkXQ(3).Value = 0 And chkXQ(4).Value = 0 And chkXQ(5).Value = 0 And chkXQ(6).Value = 0 And chkXQ(7).Value = 0 Then
MsgBox "条件不足，请选择学期！", vbInformation, "信息提示框"
Exit Sub
End If
L = 1
QueryCount = 0
'设置查询数组 Query
For K = 0 To 7
If chkXQ(K).Value = 1 Then
QueryCount = QueryCount + 1
Select Case K
Case 0
Query(L) = "1"
Case 1
Query(L) = "2"
Case 2
Query(L) = "3"
Case 3
Query(L) = "4"
Case 4
Query(L) = "5"
Case 5
Query(L) = "6"
Case 6
Query(L) = "7"
Case 7
Query(L) = "8"
End Select
L = L + 1
End If
Next K
'根据条件数编制条件语句并产生记录集
Select Case QueryCount
Case 0
MsgBox "无选择条件", vbInformation
Exit Sub
Case 1
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "'"
Case 2
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "'"
Case 3
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "'"
Case 4
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "'"
Case 5
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "'"
Case 6
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "'"
Case 7
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "'"
Case 8
SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "' or 学期='" + Trim(Query(8)) + "'"
End Select
Set recForXM = DAT.OpenRecordset(SQLFORXM, dbOpenSnapshot)
Set Data1.Recordset = recForXM
'计算综合分
Dim I As Integer
Dim J As Integer
Dim Sum As Double
Dim XF As Double
Dim txtone(0 To 60) As Double
Dim TXTMARK(0 To 60) As Double
J = 0
If recForXM.RecordCount <> 0 Then
recForXM.MoveLast
recForXM.MoveFirst
txtone(J) = recForXM.Fields(1)
TXTMARK(J) = recForXM.Fields(3)
J = J + 1
For I = 1 To recForXM.RecordCount - 1
recForXM.MoveNext
txtone(J) = recForXM.Fields(1)
TXTMARK(J) = recForXM.Fields(3)
J = J + 1
Next I
Sum = 0
XF = 0
For I = 0 To 60
If txtone(I) <> 0 Then
Sum = Sum + TXTMARK(I) * txtone(I)
XF = XF + txtone(I)
End If
Next I
txtZHF = Left(CStr(Sum / XF), 7)
End If
DBGrid1.Columns(0).Width = 1700
DBGrid1.Columns(1).Width = 1030
DBGrid1.Columns(2).Width = 1020
DBGrid1.Columns(3).Width = 1250
End Sub
Private Sub Command2_Click()
'On Error Resume Next
Call Command1_Click
If LSTBJ.Text = "" Then
MsgBox "请选择班级信息!", vbInformation, "信息提示框"
Exit Sub
End If
If chkXQ(0).Value = 0 And chkXQ(1).Value = 0 And chkXQ(2).Value = 0 And chkXQ(3).Value = 0 And chkXQ(4).Value = 0 And chkXQ(5).Value = 0 And chkXQ(6).Value = 0 And chkXQ(7).Value = 0 Then
MsgBox "无排序条件，请选择学期！", vbInformation, "信息提示框"
frmMark.MousePointer = 0
Label4.Visible = False
Exit Sub
End If
'COMM
If lstXM.Text = "" Then
MsgBox "请任意选择一位学生姓名!", vbInformation, "信息提示框"
Exit Sub
End If
If Data1.Recordset.BOF And Data1.Recordset.EOF Then MsgBox "无成绩可供排序", vbInformation + vbOKOnly, "出错信息": Exit Sub
MakeArray
PX
Merge
End Sub
Private Sub Command2_GotFocus()
On Error Resume Next
If lstXM.Text = "" Then
Exit Sub
End If
If chkXQ(0).Value = 0 And chkXQ(1).Value = 0 And chkXQ(2).Value = 0 And chkXQ(3).Value = 0 And chkXQ(4).Value = 0 And chkXQ(5).Value = 0 And chkXQ(6).Value = 0 And chkXQ(7).Value = 0 Then
Label4.Visible = False
Else
'Label4.Visible = True
End If
'frmMark.MousePointer = 11
End Sub
Private Sub Command2_LostFocus()
On Error Resume Next
Label4.Visible = False
frmMark.MousePointer = 0
End Sub
Private Sub Command3_Click()
On Error Resume Next
Dim I As Integer
For I = 0 To 7
chkXQ(I).Value = 0
Next I
txtZHF.Text = ""
End Sub
Private Sub Command4_Click()
'On Error Resume Next
Unload Me
End Sub
Private Sub Form_Load()
'On Error Resume Next
Dim I As Integer
'Set dbStudent = OpenDatabase(App.Path + "\database", False, False, "FoxPro 2.6;")
For I = 0 To 7
chkXQ(I).Enabled = False
Next I
Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'On Error Resume Next
Unload Me
End Sub
Private Sub Label3_Click()
Dim ex As Excel.Application
Dim exwbook As Excel.WorkBook
Dim exsheet As Excel.WorkSheet
Dim exchart As Excel.Chart
Dim I, J As Integer
If MsgBox("确信要打印个人成绩大表？", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
Else
Set ex = CreateObject("excel.application")
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
Dim REC As Recordset
Dim q As Integer
Screen.MousePointer = 11
Set REC = Data1.Recordset
If REC.AbsolutePosition = -1 Then
MsgBox "无信息可供打印,退出!", vbExclamation, "错误信息"
GoTo 10
End If
REC.MoveLast
REC.MoveFirst
q = REC.RecordCount
ex.Caption = "学生成绩大表"
ex.Cells(1, 2).Value = "成绩一览"
ex.Cells(3, 1).Value = "课程"
ex.Cells(3, 2).Value = "学分"
ex.Cells(3, 3).Value = "学期"
ex.Cells(3, 4).Value = "成绩"
For I = 4 To q + 3
For J = 1 To 4
ex.Cells(I, J).Value = REC(J - 1).Value
Next J
REC.MoveNext
Next I
ex.Visible = True
exwbook.Saved = True
REC.MoveFirst
10:
Screen.MousePointer = vbArrow
Set exsheet = Nothing
Set exwbook = Nothing
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -