📄 form1.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "成绩表"
ClientHeight = 6525
ClientLeft = 60
ClientTop = 300
ClientWidth = 9195
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6525
ScaleWidth = 9195
Begin VB.PictureBox Pic
Height = 435
Left = 4245
ScaleHeight = 375
ScaleWidth = 3315
TabIndex = 2
Top = 5790
Width = 3375
Begin VB.CommandButton Command1
Caption = "收集"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 30
TabIndex = 5
Top = 15
Width = 1100
End
Begin VB.CommandButton CmdPrint
Caption = "打印"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1110
TabIndex = 4
Top = 30
Width = 1100
End
Begin VB.CommandButton CmdExit
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2220
TabIndex = 3
Top = 15
Width = 1100
End
End
Begin MSFlexGridLib.MSFlexGrid flxgd1
Height = 4350
Left = 330
TabIndex = 1
Top = 1140
Width = 8415
_ExtentX = 14843
_ExtentY = 7673
_Version = 327680
Rows = 70
Cols = 9
FixedCols = 0
BackColorFixed = 16777215
BackColorBkg = 16777215
GridColor = 0
FillStyle = 1
AllowUserResizing= 1
Appearance = 0
FormatString = "^课程 | 一学期| 二学期| 三学期| 四学期| 五学期| 六学期| 七学期| 八学期"
End
Begin MSFlexGridLib.MSFlexGrid flxgd2
Bindings = "Form1.frx":0000
Height = 555
Left = 330
TabIndex = 0
Top = 570
Width = 8145
_ExtentX = 14367
_ExtentY = 979
_Version = 327680
FixedCols = 0
BackColorFixed = 16777215
BackColorBkg = 16777215
GridColor = 0
FillStyle = 1
Appearance = 0
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 2505
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 435
Visible = 0 'False
Width = 1140
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "成绩表"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 330
Left = 2610
TabIndex = 6
Top = 165
Width = 3870
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Liewidth(100) As Single
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdPrint_Click()
On Error GoTo df
Dim h As Single
Dim l As Single
Dim iline As Integer
Dim lie As Integer
flxgd2.Row = 1
flxgd2.Col = 1
Label1.Caption = kaishifrm.List1.List(kaishifrm.List1.ListIndex) & "" & flxgd2.Text & "" & "八学期成绩表 "
DoEvents
If Me.Width > 4000 Then
Printer.CurrentX = Me.Width / 3 - 200
DoEvents
Else
Printer.CurrentX = 200
End If
Printer.CurrentY = 200
Printer.FontBold = True
Printer.FontSize = 12
DoEvents
Printer.Print Label1.Caption
DoEvents
For iline = 150 To Me.Width - 200 Step 110
Printer.CurrentY = 480
Printer.CurrentX = iline
Printer.Print "_"
Next iline
DoEvents
For h = 0 To flxgd1.Rows - 2
Printer.CurrentY = 310 * h + 840
flxgd1.Row = h
'====================
Call printline(310 * h + 840, Form1)
'=======================
For l = 0 To flxgd1.Cols - 1
Printer.CurrentY = 310 * h + 800
flxgd1.Col = l
Select Case l
Case 0
Printer.CurrentX = 200
Case Else
Liewidth(100) = 1000
For lie = 0 To l - 1
Liewidth(100) = Liewidth(100) + 850
Next lie
Printer.CurrentX = Liewidth(100)
End Select
DoEvents
DoEvents
Printer.FontSize = 10
DoEvents
DoEvents
Printer.Print flxgd1.Text
DoEvents
DoEvents
'me.printline (printer.currenty + 200)
DoEvents
DoEvents
Next l
Next h
Printer.CurrentY = 300 * (flxgd1.Rows) + 1280
Printer.CurrentX = Me.Width - 1000
Printer.FontSize = 12
Printer.Print Date
DoEvents
DoEvents
Printer.EndDoc
DoEvents
DoEvents
Exit Sub
df:
MsgBox "未知错误!"
End Sub
Private Sub Command1_Click()
On Error GoTo sh
Dim tabb As TableDef
Dim flxgd1h As Integer
Dim inin As Integer
Dim rename As String
Dim re As Integer '重名的行号
Dim rdsource(4) As String
Dim xueqi As Integer
Dim fh(7) As Integer
Dim X As Integer
flxgd1.Refresh
flxgd1.Rows = 100
xueqi = 1
inin = InputBox("请输入学号")
flxgd1h = 1
For Each tabb In dbname.TableDefs
If Right(tabb.Name, 5) = "学分记录表" Then
rdsource(1) = " SELECT * FROM "
rdsource(2) = tabb.Name & " WHERE 学号="
rdsource(3) = inin
rdsource(4) = rdsource(1) & rdsource(2) & rdsource(3)
'Data1.Refresh
Data1.DatabaseName = dbname.Name
Data1.RecordSource = rdsource(4) '"SELECT * FROM 第1学期学分记录表 WHERE 学号=4" 'rdsource(1) & rdsource(2) & rdsource(3)
Data1.Refresh
flxgd2.Refresh
flxgd2.Row = 1
flxgd2.Col = 1
Label1.Caption = kaishifrm.List1.List(kaishifrm.List1.ListIndex) & "" & flxgd2.Text & "" & "八学期成绩表 "
For i = 1 To 10000
DoEvents
Next i
For i = 2 To flxgd2.Cols - 1 'fff
flxgd1.Row = flxgd1h
flxgd1.Col = 0
flxgd2.Row = 0
flxgd2.Col = i
re = 0
rename = flxgd2.Text
'==新的课名原有吗?
If Right(flxgd2.Text, 1) <> ")" Then GoTo df
Do
DoEvents
re = re + 1
flxgd1.Row = re
flxgd1.Col = 0
If re + 1 > flxgd1h Then Exit Do '循环到现有新表(flxgd1)总行数即跳出
Loop Until rename = flxgd1.Text '有即跳出
If re < flxgd1h Then 'ifff
flxgd1.Row = re '重名 ,指向 re(重名处)
flxgd1h = flxgd1h - 1 '因为flxgd1h指向新空的flxgd1的行,所以停止移动
Else
flxgd1.Row = flxgd1h '不重名
flxgd1.Text = rename
End If 'ifff
flxgd1.Col = xueqi
flxgd2.Row = 1
flxgd1.Text = flxgd2.Text
flxgd1h = flxgd1h + 1
df:
Next i 'fff
xueqi = xueqi + 1
End If
Next
flxgd1.Rows = flxgd1h
flxgd1.ColWidth(0) = 1400
If flxgd1h < 18 Then
flxgd1.Width = 8275
flxgd1.Height = flxgd1h * 245
Else
flxgd1.Width = 8415
flxgd1.Height = 18 * 245
End If
flxgd2.Width = flxgd1.Width
Data1.RecordSource = "SELECT * FROM 毕业表 WHERE 学号=" & rdsource(3) 'rdsource(1) & rdsource(2)
flxgd2.Refresh
Data1.Refresh
flxgd2.ColWidth(0) = 500
flxgd2.ColWidth(1) = 900
For i = 2 To 9
DoEvents
flxgd2.ColWidth(i) = 850
Next i
flxgd2.Width = flxgd1.Width + 10
DoEvents
flxgd2.RowHeight(0) = 280
flxgd2.RowHeight(1) = 280
flxgd2.Height = 600
Me.Top = 20
Me.Left = 20
coverFrm.Width = Me.Width + 200
coverFrm.Height = Me.Height + 400
Exit Sub
sh:
If Err.Number = 30009 Then _
MsgBox "学号错1 "
If Err.Number = 13 Then _
Exit Sub
End Sub
Private Sub Form_Load()
Me.Top = kaishifrm.Top
Me.Left = kaishifrm.Left
Me.Height = 6885
flxgd1.Font.Bold = True
flxgd1.Font.Size = 10
flxgd2.Font.Bold = True
flxgd2.Font.Size = 10
Label1.Caption = kaishifrm.List1.List(kaishifrm.List1.ListIndex) & "同学" & "八学期成绩表 "
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
coverFrm.WindowState = 2
DoEvents
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -