📄 frmsavestatistic.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmSaveStatistic
BorderStyle = 3 'Fixed Dialog
Caption = "充值统计"
ClientHeight = 3525
ClientLeft = 45
ClientTop = 330
ClientWidth = 5445
Icon = "frmSaveStatistic.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3525
ScaleWidth = 5445
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame fraFind
Caption = "充值统计信息"
Height = 2175
Left = 240
TabIndex = 0
Top = 240
Width = 4935
Begin VB.ComboBox cboSort
Height = 300
ItemData = "frmSaveStatistic.frx":000C
Left = 1440
List = "frmSaveStatistic.frx":0016
Style = 2 'Dropdown List
TabIndex = 18
Top = 360
Width = 1815
End
Begin VB.CommandButton cmdList
Caption = "...."
Height = 255
Left = 2760
TabIndex = 13
Top = 840
Width = 495
End
Begin VB.CommandButton cmdPrint
Caption = "打印预览"
Height = 375
Left = 3600
TabIndex = 5
Top = 1080
Width = 975
End
Begin VB.CommandButton cmdfFind
Caption = "统 计"
Default = -1 'True
Height = 375
Left = 3600
TabIndex = 4
Top = 480
Width = 975
End
Begin VB.ComboBox cboFindType
Height = 300
ItemData = "frmSaveStatistic.frx":0030
Left = 1440
List = "frmSaveStatistic.frx":003A
Style = 2 'Dropdown List
TabIndex = 3
Top = 1200
Width = 1815
End
Begin VB.ComboBox cboUser
Height = 300
Left = 1440
Style = 2 'Dropdown List
TabIndex = 2
Top = 780
Width = 1815
End
Begin VB.TextBox txtCH_ID
Height = 270
Left = 1440
MaxLength = 10
TabIndex = 1
Top = 840
Width = 1335
End
Begin MSComCtl2.DTPicker DTPTo
Height = 300
Left = 3240
TabIndex = 6
Top = 1680
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 24641537
CurrentDate = 38057
End
Begin MSComCtl2.DTPicker DTPFrom
Height = 300
Left = 1440
TabIndex = 7
Top = 1680
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 24641537
CurrentDate = 38057
End
Begin VB.Label lblSort
AutoSize = -1 'True
Caption = "查询内容："
Height = 180
Left = 360
TabIndex = 17
Top = 420
Width = 900
End
Begin VB.Label lblTo
AutoSize = -1 'True
Caption = "到："
Height = 180
Left = 2880
TabIndex = 12
Top = 1740
Width = 360
End
Begin VB.Label lblFrom
AutoSize = -1 'True
Caption = "从："
Height = 180
Left = 360
TabIndex = 11
Top = 1680
Width = 360
End
Begin VB.Label lblType
AutoSize = -1 'True
Caption = "查询方式："
Height = 180
Left = 360
TabIndex = 10
Top = 1260
Width = 900
End
Begin VB.Label lbluser
AutoSize = -1 'True
Caption = "用户："
Height = 180
Left = 360
TabIndex = 9
Top = 840
Width = 540
End
Begin VB.Label lblCH_ID
AutoSize = -1 'True
Caption = "持卡人ID："
Height = 180
Left = 360
TabIndex = 8
Top = 840
Width = 900
End
End
Begin VB.Label lblInfo
AutoSize = -1 'True
Height = 180
Left = 600
TabIndex = 16
Top = 3120
Width = 90
End
Begin VB.Label lblList
AutoSize = -1 'True
Caption = "充值说明："
Height = 180
Left = 360
TabIndex = 15
Top = 2640
Width = 900
End
Begin VB.Label lblnumber
AutoSize = -1 'True
Height = 180
Left = 600
TabIndex = 14
Top = 2880
Width = 90
End
End
Attribute VB_Name = "frmSaveStatistic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RsCardholder As Recordset
Public rsSaving As Recordset
Dim rsSavingSum As Recordset
Public strMoney As String
Dim strCH As String
Dim strinfo As String
Dim rsUser As Recordset
Dim strFrom As String
Dim strUser As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''根据用户的日期选择，显示或隐藏相关信息 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cboFindType_Click()
If cboFindType.Text = "单日查询" Then
lblFrom.Caption = "查询日期："
lblTo.Visible = False
DTPTo.Visible = False
DTPFrom.Width = 1800
ElseIf cboFindType.Text = "时间段查询" Then
lblFrom.Caption = "从："
lblTo.Visible = True
DTPTo.Visible = True
DTPFrom.Width = 1335
End If
End Sub
Private Sub cboSort_Change()
If cboSort.Text = "按用户查" Then
lbluser.Visible = True
cboUser.Visible = True
lblCH_ID.Visible = False
txtCH_ID.Visible = False
txtCH_ID.Text = ""
cmdList.Visible = False
ElseIf cboSort.Text = "按持卡人查" Then
lbluser.Visible = False
cboUser.Visible = False
cboUser.ListIndex = -1
lblCH_ID.Visible = True
txtCH_ID.Visible = True
cmdList.Visible = True
End If
End Sub
Private Sub cboSort_Click()
If cboSort.Text = "按用户查" Then
lbluser.Visible = True
cboUser.Visible = True
lblCH_ID.Visible = False
txtCH_ID.Visible = False
cmdList.Visible = False
ElseIf cboSort.Text = "按持卡人查" Then
lbluser.Visible = False
cboUser.Visible = False
lblCH_ID.Visible = True
txtCH_ID.Visible = True
cmdList.Visible = True
End If
End Sub
Private Sub cmdfFind_Click()
lblnumber.Caption = ""
lblInfo.Caption = ""
cmdPrint.Enabled = True
Set rsSaving = New Recordset
Dim strfind As String
strfind = "select * from TbSAVING,tbuser" & where & " and TbSAVING.u_id=tbuser.u_id"
rsSaving.Open strfind, Modmain.conn, 3, 2
Set rsSavingSum = New Recordset
Dim strfindSum As String
strfindSum = "select sum(money) as SumMoney from TbSAVING,tbuser" & where & " and TbSAVING.u_id=tbuser.u_id"
rsSavingSum.Open strfindSum, Modmain.conn, 3, 2
'If rsSavingSum.Fields!SumMoney <> 0 Then
' strMoney = "充值" & rsSavingSum.Fields!SumMoney & "元"
'End If
If txtCH_ID.Text <> "" Then
Set RsCardholder = New Recordset
RsCardholder.Open "select * from TbCardholder where ch_ID like '" & txtCH_ID.Text & "'", Modmain.conn, 3, 2
strCH = "持卡人" & RsCardholder.Fields!CH_Name & ",现在剩余" & RsCardholder.Fields!Money & "元"
If rsSavingSum.Fields!SumMoney <> 0 Then
strMoney = "充值" & rsSavingSum.Fields!SumMoney & "元"
lblnumber.Caption = strCH
lblInfo.Caption = strFrom & strMoney
Else
lblnumber.Caption = "所选条件下无充值信息"
End If
ElseIf cboUser.Text <> "" Then
If rsSavingSum.Fields!SumMoney <> 0 Then
strMoney = "充值" & rsSavingSum.Fields!SumMoney & "元"
lblnumber.Caption = strUser & strFrom & strMoney
Else
lblnumber.Caption = "所选条件下无充值信息"
End If
ElseIf cboUser.Text = "" And txtCH_ID.Text = "" Then
If rsSavingSum.Fields!SumMoney <> 0 Then
strMoney = "充值" & rsSavingSum.Fields!SumMoney & "元"
lblnumber.Caption = strFrom & strMoney
Else
lblnumber.Caption = "所选条件下无充值信息"
End If
End If
frmHourStatistic.AddLog ("L21") ''将用户统计上机情况的信息记入操作日志 ''
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''显示持卡人窗体，供用户选择持卡人 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdList_Click()
frmCardholderList.StrForm = "frmSaveStatistic"
frmCardholderList.Show 1
txtCH_ID.SetFocus
End Sub
Private Sub cmdPrint_Click()
If rsSaving.RecordCount <> 0 Then
DRSaveStatistic.Show 1
frmHourStatistic.AddLog ("L24") ''将用户打印上机情况统计结果的信息记入操作日志
Else
MsgBox "没有可打印的信息！", vbOKOnly + vbExclamation, "机房管理"
End If
End Sub
Private Sub DTPFrom_Change()
If DTPFrom.Value <> "" Then
DTPTo.MinDate = DTPFrom.Value
End If
End Sub
Private Sub Form_Load()
cmdPrint.Enabled = False
Set rsUser = New Recordset
rsUser.Open "select * from TbUser", Modmain.conn, 3, 2
While Not rsUser.EOF
cboUser.AddItem (rsUser.Fields!u_name)
rsUser.MoveNext
Wend
cboUser.AddItem ""
rsUser.Close
Set rsUser = Nothing
lblCH_ID.Visible = False
txtCH_ID.Visible = False
cmdList.Visible = False
End Sub
Private Function where() As String '查询条件
Dim s As String
If txtCH_ID.Text <> "" Then
s = " where C_ID like '%" & Trim(txtCH_ID.Text) & "%'"
End If
If DTPTo.Visible = False Then
If s <> "" Then
s = s & "and Date like '" & DTPFrom.Value & "'"
Else
s = " where Date like '" & DTPFrom.Value & "'"
End If
strFrom = "在" & Year(DTPFrom.Value) & "年" & Month(DTPFrom.Value) & "月" & Day(DTPFrom.Value) & "日"
Else
Dim dtFrom As String
Dim dtTo As String
'''''''''''''''''手工转换日期格式使其与ACCESS数据库相对应''''''''''''''''''''''''
dtFrom = Month(DTPFrom.Value) & "/" & Day(DTPFrom.Value) & "/" & Year(DTPFrom.Value)
dtTo = Month(DTPTo.Value) & "/" & Day(DTPTo.Value) & "/" & Year(DTPTo.Value)
If s <> "" Then
s = s & "and Date>= #" & dtFrom & "# and Date<=#" & dtTo & "#"
Else
s = " where Date>=#" & dtFrom & "# and Date<=#" & dtTo & "#"
End If
strFrom = "从" & Year(DTPFrom.Value) & "年" & Month(DTPFrom.Value) & "月" & Day(DTPFrom.Value) & "日到" & Year(DTPTo.Value) & "年" & Month(DTPTo.Value) & "月" & Day(DTPTo.Value) & "日"
End If
If cboUser.Text <> "" Then
Set rsUser = New Recordset
rsUser.Open "select * from TbUser Where U_Name like '" & cboUser.Text & "'", Modmain.conn, 3, 2
If s <> "" Then
s = s & " and tbuser.U_ID like '" & rsUser.Fields!U_ID & "'"
Else
s = " where tbuser.U_ID like '" & rsUser.Fields!U_ID & "'"
End If
strUser = "用户" & cboUser.Text
End If
where = s
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -