📄 frmcjxmcx.frm
字号:
VERSION 5.00
Object = "{DD44C0E7-B2CF-11D1-8DD3-444553540000}#1.0#0"; "cell32.ocx"
Begin VB.Form frmCjxmcx
Caption = "按姓名查询成绩"
ClientHeight = 6690
ClientLeft = 135
ClientTop = 1545
ClientWidth = 11460
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6690
ScaleWidth = 11460
Begin VB.CommandButton Command1
Caption = "查询(&Q)"
Height = 375
Left = 9960
TabIndex = 6
Top = 600
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "打印(&P)"
Height = 375
Left = 9960
TabIndex = 5
Top = 1200
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "返回(&X)"
Height = 375
Left = 9960
TabIndex = 4
Top = 1800
Width = 1215
End
Begin VB.Frame Frame1
Height = 735
Left = 0
TabIndex = 0
Top = 0
Width = 9615
Begin VB.TextBox Text1
Height = 270
Left = 960
TabIndex = 1
Text = "User69"
Top = 300
Width = 1815
End
Begin VB.Label Label1
Caption = "姓名："
Height = 255
Left = 240
TabIndex = 2
Top = 360
Width = 1455
End
End
Begin CELLLib.Cell Cell1
Height = 5535
Left = 0
TabIndex = 3
TabStop = 0 'False
Top = 840
Width = 9615
_Version = 65536
_ExtentX = 16960
_ExtentY = 9763
_StockProps = 0
End
End
Attribute VB_Name = "frmCjxmcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************************************
' 过程：Command1_Click
' 功能：根据姓名(text1.text)查询成绩
'***************************************************************************************
Private Sub Command1_Click()
Dim objRs1 As ADODB.Recordset
Dim objRs As ADODB.Recordset
Dim strTemp As String, strXqmc(8) As String, strExec As String
Dim numcol As Integer, numRow As Integer
strXqmc(0) = "第一学期"
strXqmc(1) = "第二学期"
strXqmc(2) = "第三学期"
strXqmc(3) = "第四学期"
strXqmc(4) = "第五学期"
strXqmc(5) = "第六学期"
strXqmc(6) = "第七学期"
strXqmc(7) = "第八学期"
Set objRs = objCon.Execute("Select * From XSDAB Where xm='" & Trim(Text1.Text) & "'")
If objRs.EOF Then
MsgBox "不存在姓名为<" & Text1.Text & ">的学生档案！", vbCritical, "错误信息"
' 无法查询学生档案，不允许查询成绩
Else
strTemp = IIf(Len(Trim(objRs("xbbh"))) = 1, "0" & Trim(objRs("xbbh")), Trim(objRs("xbbh"))) & IIf(Len(Trim(objRs("zybh"))) = 1, "0" & Trim(objRs("zybh")), Trim(objRs("zybh")))
strExec = "Select * From XKQKB Where left(kcbmc,10)='CJ" & Trim(objRs("nj")) & strTemp & "' Order By kcbmc"
' 根据学生档案相关数据，查找选课数据
Set objRs = objCon.Execute(strExec)
If objRs.EOF Then
MsgBox "没有找到任何成绩数据，请您检查相关数据！", vbCritical, "错误信息"
Else
Cell_Setup Cell1
Cell1.DoAppendCol 10
Cell1.DoAppendRow 1
Cell1.DoSetCellReadOnly 0, 0, True
For numI = 2 To 9
' 设置表头“第X学期”
Cell1.DoSetCellString numI, 0, Trim(strXqmc(numI - 2))
Cell1.DoSetCellAlignment numI, 0, 36
Cell1.DoSetCellReadOnly numI, 0, True
Next
Cell1.DoJoinCells 0, 0, 1, 0
numRow = 1
Do While Not objRs.EOF
Set objRs1 = objCon.Execute("Select * From " & Trim(objRs("kcbmc")) & " Where xh='" & fGetXh(Text1.Text) & "'")
If Not objRs1.EOF Then
' 查询学生成绩
For numI = 1 To 10
If objRs("kcbh" & Trim(Str(numI))) <> "" Then
Cell1.DoAppendRow 1
Cell1.DoSetCellString 0, numRow, Trim(fGetKcmc(objRs("kcbh" & Trim(Str(numI)))))
Cell1.DoSetCellAlignment 0, numRow, 36
Cell1.DoSetCellReadOnly 0, numRow, True
Select Case Trim(objRs("pffs" & Trim(Str(numI))))
Case "0"
Cell1.DoSetCellString 1, numRow, "总成绩"
Cell1.DoSetCellAlignment 1, numRow, 36
Cell1.DoSetCellReadOnly 1, numRow, True
If objRs1("zcj" & Trim(Str(numI))) <> 0 Then
Cell1.DoSetCellData Val(Right(objRs("kcbmc"), 2)) + 1, numRow, objRs1("zcj" & Trim(Str(numI)))
End If
numRow = numRow + 1
Case "1"
Cell1.DoAppendRow 2
Cell1.DoJoinCells 0, numRow, 0, numcol + 2
Cell1.DoSetCellString 1, numRow, "理论成绩"
Cell1.DoSetCellString 1, numRow + 1, "实训成绩"
Cell1.DoSetCellString 1, numRow + 2, "总成绩"
Cell1.DoSetCellAlignment 1, numRow, 36
Cell1.DoSetCellAlignment 1, numRow + 1, 36
Cell1.DoSetCellAlignment 1, numRow + 2, 36
Cell1.DoSetCellReadOnly 1, numRow, True
Cell1.DoSetCellReadOnly 1, numRow + 1, True
Cell1.DoSetCellReadOnly 1, numRow + 2, True
Cell1.DoJoinCells 0, numRow, 0, numRow + 2
If objRs1("llcj" & Trim(Str(numI))) <> 0 Then
Cell1.DoSetCellData Val(Right(objRs("kcbmc"), 2)) + 1, numRow, objRs1("llcj" & Trim(Str(numI)))
End If
If objRs1("sxcj" & Trim(Str(numI))) <> 0 Then
Cell1.DoSetCellData Val(Right(objRs("kcbmc"), 2)) + 1, numRow + 1, objRs1("sxcj" & Trim(Str(numI)))
End If
If objRs1("zcj" & Trim(Str(numI))) <> 0 Then
Cell1.DoSetCellData Val(Right(objRs("kcbmc"), 2)) + 1, numRow + 2, objRs1("zcj" & Trim(Str(numI)))
End If
numRow = numRow + 3
Case "2"
Cell1.DoSetCellString 1, numRow, "学分"
Cell1.DoSetCellAlignment 1, numRow, 36
Cell1.DoSetCellReadOnly 1, numRow, True
If objRs1("xf" & Trim(Str(numI))) <> 0 Then
Cell1.DoSetCellData Val(Right(objRs("kcbmc"), 2)) + 1, numRow, objRs1("xf" & Trim(Str(numI)))
End If
numRow = numRow + 1
Case "3"
Cell1.DoSetCellString 1, numRow, "考查成绩"
Cell1.DoSetCellAlignment 1, numRow, 36
Cell1.DoSetCellReadOnly 1, numRow, True
If objRs1("kccj" & Trim(Str(numI))) <> "" Then
Cell1.DoSetCellString Val(Right(objRs("kcbmc"), 2)) + 1, numRow, Trim(objRs1("kccj" & Trim(Str(numI))))
End If
numRow = numRow + 1
End Select
End If
Next
End If
objRs.MoveNext
Loop
Text1.SetFocus
Cell1.DoMoveToCell 2, 1
Command2.Enabled = True
' 允许打印
End If
End If
objRs.Close
End Sub
'***************************************************************************************
' 过程：Command2_Click
' 功能：打印已经查询的课程成绩
'***************************************************************************************
Private Sub Command2_Click()
MsgBox "请在打印机中放入A4打印纸...", vbOKOnly, "数据打印"
Load FrmPrePrint
' 调入打印预览窗口
Cell1.DoCopyArea 0, 0, Cell1.Cols - 1, Cell1.Rows - 1
' 复制数据到剪贴板中
FrmPrePrint.Cell1.DoPaste 0, 0, True
' 粘贴数据到打印窗口中
FrmPrePrint.Cell1.Cols = Cell1.Cols
FrmPrePrint.Cell1.Rows = Cell1.Rows
FrmPrePrint.Cell1.DoInsertRow 0, 1
' 设置报表标题
FrmPrePrint.Cell1.DoJoinCells 0, 0, FrmPrePrint.Cell1.Cols - 1, 0
FrmPrePrint.Cell1.DoSetRowHeight 0, 60
FrmPrePrint.Cell1.DoSetCellFont 0, 0, 12, 1, "宋体"
' 12号宋体字，粗体
FrmPrePrint.Cell1.DoSetCellString 0, 0, Trim(Text1.Text) & " 成绩总表"
FrmPrePrint.Cell1.DoSetCellAlignment 0, 0, 36
' 设置页脚：页号 日期
FrmPrePrint.Cell1.DoSetPrintFoot "", "&P &D", ""
' 显示网格
FrmPrePrint.Cell1.DoDrawLine 0, 1, FrmPrePrint.Cell1.Cols, FrmPrePrint.Cell1.Rows, 0, 1, 0
FrmPrePrint.Cell1.DoSetPrintPara 1, 9, False
FrmPrePrint.Cell1.DoPrintPreview True
Unload FrmPrePrint
End Sub
'***************************************************************************************
' 过程：Form_Load
' 功能：窗体装入时进行初始化
'***************************************************************************************
Private Sub Form_Load()
Command1.Enabled = True
Command2.Enabled = False
' 不允许使用打印功能
Cell_Setup Cell1
End Sub
'***************************************************************************************
' 过程：Form_QueryUnload
' 功能：窗体关闭时恢复主窗口
'***************************************************************************************
Private Sub Form_Unload(Cancel As Integer)
FrmMain.Enabled = True
End Sub
'***************************************************************************************
' 过程：Command3_Click
' 功能：“关闭”按钮按下时恢复主窗口
'***************************************************************************************
Private Sub Command3_Click()
Unload frmCjxmcx
FrmMain.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -