📄 frmxuefei2.frm
字号:
Begin MSComctlLib.ImageList ImageList1
Left = 7320
Top = 240
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frmxuefei2.frx":0000
Key = "del"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frmxuefei2.frx":0458
Key = "print"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frmxuefei2.frx":0AD4
Key = "find"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Frmxuefei2.frx":0F28
Key = "modi"
EndProperty
EndProperty
End
End
Attribute VB_Name = "Frmxuefei2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public printstr As String
Public Sub xuefeishowtitle()
Dim i As Integer
With MSF1
.Cols = 6
.TextMatrix(0, 1) = "年级"
.TextMatrix(0, 2) = "专业"
.TextMatrix(0, 3) = "年制"
.TextMatrix(0, 4) = "学期"
.TextMatrix(0, 5) = "学费(元)"
.ColWidth(0) = 200
.ColWidth(1) = 2000
.ColWidth(2) = 2000
.ColWidth(3) = 2000
.ColWidth(4) = 3000
.ColWidth(5) = 1500
.FixedRows = 1
For i = 1 To 5
.ColAlignment(i) = 0
Next i
.FillStyle = flexFillSingle
.Col = 0
.Row = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
.Row = 1
End With
End Sub
Public Sub xuefeishowdata()
MSF1.Clear
Dim j As Integer
Dim i As Integer
xuefeishowtitle
MSF1.Rows = 2
Dim mrc As ADODB.Recordset
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = False Then
mrc.MoveFirst
With MSF1
.Rows = 4
.Row = 1
Do While Not mrc.EOF
.Rows = .Rows + 1
For i = 1 To mrc.Fields.Count
.TextMatrix(.Row, i) = mrc.Fields(i - 1)
Next i
.Row = .Row + 1
mrc.MoveNext
Loop
End With
xuefeishowtitle
Else
If xuefeifind = True Then
Frmxuefei2.Hide
Frmxuefei3.Show
zzz = MsgBox("对不起,没有此班级的学费设置档案记录!", vbOKOnly, "查询")
Frmxuefei3.ZOrder (0)
'Else
' With MSF1
' .TextMatrix(1, 1) = ""
'.TextMatrix(1, 2) = ""
' .TextMatrix(1, 3) = ""
' .TextMatrix(1, 4) = ""
' .TextMatrix(1, 5) = ""
'End With
End If
End If
mrc.Close
End Sub
Private Sub Combo1_Click(Index As Integer)
If Option1.Value = True Then
Else
txtsql = "select * from xuefei where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "' and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & Trim(Combo1(3).Text) & "'"
xuefeishowdata
printstr = txtsql
End If
'xuefeishowtitle
'xuefeishowdata
End Sub
Private Sub Form_Activate()
If xuefeimodi = True Then
xuefeishowdata
xuefeimodi = False
End If
'Else
' MDIForm1.xfbrowse
'End If
End Sub
Private Sub Form_Load()
If Option1.Value = True Then
txtsql = "select * from xuefei order by 学期,专业,年制"
For i = 0 To 3
Combo1(i).Enabled = False
Next i
printstr = txtsql
xuefeishowdata
End If
End Sub
Private Sub Option1_Click()
For i = 0 To 3
Combo1(i).Enabled = False
Next i
txtsql = "select * from xuefei order by 学期,专业,年制"
xuefeishowdata
printstr = txtsql
End Sub
Private Sub Option2_Click()
For i = o To 3
Combo1(i).Enabled = True
Next i
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 年级 from xuefei "
Set mrc = ExecuteSQL(txtsql)
mrc.MoveFirst
Combo1(0).Clear
Do While Not mrc.EOF
Combo1(0).AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo1(0).ListIndex = 0
txtsql = "select DISTINCT 专业 from xuefei"
Set mrc = ExecuteSQL(txtsql)
Combo1(1).Clear
mrc.MoveFirst
Do While Not mrc.EOF
Combo1(1).AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo1(1).ListIndex = 0
txtsql = "select DISTINCT 年制 from xuefei"
Set mrc = ExecuteSQL(txtsql)
Combo1(2).Clear
mrc.MoveFirst
Do While Not mrc.EOF
Combo1(2).AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo1(2).ListIndex = 0
txtsql = "select DISTINCT 学期 from xuefei "
Set mrc = ExecuteSQL(txtsql)
Combo1(3).Clear
mrc.MoveFirst
Do While Not mrc.EOF
Combo1(3).AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo1(3).ListIndex = 0
Set mrc = Nothing
' xuefeishowtitle
' xuefeishowdata
txtsql = "select * from xuefei where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "' and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & Trim(Combo1(3).Text) & "' order by 学期,专业,年制"
xuefeishowdata
printstr = txtsql
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Tag
Case "find"
Form4.Show
Case "modi"
qxstr = Executeqx(3)
If qxstr = "readonly" Then
ss = MsgBox("对不起,你是只读用户不能添加记录,请与管理员联系!", vbInformation + vbOKOnly, " 警告")
Exit Sub
End If
xuefeimodi = True
If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
MsgBox "已无记录!", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
' xuefeimodi = True
frmxuefei1.Show
frmxuefei1.xuefeiload
frmxuefei1.ZOrder 0
Case "del"
qxstr = Executeqx(3)
If qxstr = "readonly" Then
ss = MsgBox("对不起,你是只读用户不能添加记录,请与管理员联系!", vbInformation + vbOKOnly, " 警告")
Exit Sub
End If
Dim mrc As ADODB.Recordset
Dim msgtext As String
Dim intcount As Integer
If Me.MSF1.Rows > 1 Then
If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
sssss = MsgBox("已无记录!", vbOKOnly + vbExclamation, "警告")
Exit Sub
End If
If MsgBox("确定要删除此记录吗?", vbOKCancel + vbExclamation, "警告") = vbOK Then
intcount = Me.MSF1.Row
txtsql = "delete from xuefei where 年级='" & Trim(Me.MSF1.TextMatrix(Me.MSF1.Row, 1)) & "' and 专业='" & Trim(Me.MSF1.TextMatrix(Me.MSF1.Row, 2)) & "'and 年制='" & Trim(Me.MSF1.TextMatrix(Me.MSF1.Row, 3)) & "' and 学期='" & Trim(Me.MSF1.TextMatrix(Me.MSF1.Row, 4)) & "'"
Set mrc = ExecuteSQL(txtsql)
If Option1.Value = True Then
txtsql = "select * from xuefei order by 学期,专业,年制"
Else
txtsql = "select xuefei.班级,class.年级,class.专业,class.年制,xuefei.学期,xuefei.学费,xuefei.备注 from xuefei inner join class on xuefei.班级=class.班级 order by xuefei.学期 desc, class.年级 desc,class.班级 desc"
txtsql = "select * from xuefei where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "' and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & Trim(Combo1(3).Text) & "'"
End If
xuefeishowdata
End If
Else
MsgBox "你还没有选择记录!", vbExclamation + vbOKOnly, "警告"
End If
End Select
End Sub
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Select Case ButtonMenu.Key
Case "dang"
If Trim(printstr) = "" Then
sssss = MsgBox("没有当前记录!", vbOKOnly + vbExclamation, "警告")
Exit Sub
End If
If DataEnv1.rsCommand3.State = adStateOpen Then
DataEnv1.rsCommand3.Close
End If
DataEnv1.rsCommand3.Open printstr
If DataEnv1.rsCommand3.EOF = True Then
sssss = MsgBox("没有当前记录!", vbOKOnly + vbExclamation, "警告")
Exit Sub
End If
DataReportxuefei.Show 1
Case "all"
If DataEnv1.rsCommand3.State = adStateOpen Then
DataEnv1.rsCommand3.Close
End If
DataEnv1.rsCommand3.Open ("select * from xuefei")
If DataEnv1.rsCommand3.EOF = True Then
sssss = MsgBox("没有当前记录!", vbOKOnly + vbExclamation, "警告")
Exit Sub
End If
DataReportxuefei.Show 1
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -