📄 frmshangjistatistic.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmShangjiStatistic
BorderStyle = 3 'Fixed Dialog
Caption = "上机情况统计"
ClientHeight = 3660
ClientLeft = 45
ClientTop = 330
ClientWidth = 5385
Icon = "frmShangjiStatistic.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3660
ScaleWidth = 5385
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame fraShangjiStatistic
Caption = "上机情况统计"
Height = 2055
Left = 240
TabIndex = 0
Top = 240
Width = 4815
Begin VB.TextBox txtCH_ID
Height = 270
Left = 1320
MaxLength = 10
TabIndex = 5
Top = 480
Width = 1335
End
Begin VB.ComboBox cboFindType
Height = 300
ItemData = "frmShangjiStatistic.frx":000C
Left = 1320
List = "frmShangjiStatistic.frx":0016
Style = 2 'Dropdown List
TabIndex = 4
Top = 960
Width = 1815
End
Begin VB.CommandButton cmdfFind
Caption = "统 计"
Default = -1 'True
Height = 375
Left = 3480
TabIndex = 3
Top = 480
Width = 975
End
Begin VB.CommandButton cmdPrint
Caption = "打印预览"
Height = 375
Left = 3480
TabIndex = 2
Top = 960
Width = 975
End
Begin VB.CommandButton cmdList
Caption = "...."
Height = 255
Left = 2640
TabIndex = 1
Top = 488
Width = 495
End
Begin MSComCtl2.DTPicker DTPTo
Height = 300
Left = 3120
TabIndex = 6
Top = 1440
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 24707073
CurrentDate = 38057
End
Begin MSComCtl2.DTPicker DTPFrom
Height = 300
Left = 1320
TabIndex = 7
Top = 1440
Width = 1335
_ExtentX = 2355
_ExtentY = 529
_Version = 393216
Format = 24707073
CurrentDate = 38057
End
Begin VB.Label lblTo
AutoSize = -1 'True
Caption = "到："
Height = 180
Left = 2760
TabIndex = 11
Top = 1500
Width = 360
End
Begin VB.Label lblCH_ID
AutoSize = -1 'True
Caption = "持卡人ID："
Height = 180
Left = 240
TabIndex = 10
Top = 525
Width = 900
End
Begin VB.Label lblType
AutoSize = -1 'True
Caption = "查询方式："
Height = 180
Left = 240
TabIndex = 9
Top = 1020
Width = 900
End
Begin VB.Label lblFrom
AutoSize = -1 'True
Caption = "从："
Height = 180
Left = 240
TabIndex = 8
Top = 1500
Width = 360
End
End
Begin VB.Label lblList2
AutoSize = -1 'True
Height = 180
Left = 480
TabIndex = 14
Top = 3240
Width = 90
End
Begin VB.Label lblList
AutoSize = -1 'True
Height = 180
Left = 480
TabIndex = 13
Top = 2880
Width = 90
End
Begin VB.Label lblInfo
AutoSize = -1 'True
Caption = "统计说明："
Height = 180
Left = 360
TabIndex = 12
Top = 2520
Width = 900
End
End
Attribute VB_Name = "frmShangjiStatistic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsSumJiaoXue As Recordset
Dim rsSumFree As Recordset
Public rsShangJi As Recordset
Dim rsOperateLog As Recordset
Dim rsLog As Recordset
Dim STRSumTime As String
Dim strSumMoney As String
Dim strc_id As String
Dim strFrom 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 cmdfFind_Click()
cmdPrint.Enabled = True
'************************************************统计教学上机分钟数***********************
Set rsSumJiaoXue = New Recordset
Dim strHour As String
strHour = "SELECT sum(left(right([time],5),2))+sum(left([time],1))*60 AS Sumtime From tbshangji WHERE money=0" & where
rsSumJiaoXue.Open strHour, Modmain.conn, 3, 2
If Not rsSumJiaoXue.Fields!sumtime Then
STRSumTime = "教学上机" & rsSumJiaoXue.Fields!sumtime & "分钟"
Else
STRSumTime = "无教学上机"
End If
'*************************************************统计自由上机金额数***********************
Set rsSumFree = New Recordset
rsSumFree.Open "select sum(money) as SumMoney From tbshangji WHERE money<>0" & where, Modmain.conn, 3, 2
If Not rsSumFree.Fields!SumMoney Then
If CDbl(rsSumFree.Fields!SumMoney) < 1 Then
strSumMoney = ",自由上机" & "0" & CStr(CDbl(rsSumFree.Fields!SumMoney)) & "元"
Else
strSumMoney = ",自由上机" & CStr(CDbl(rsSumFree.Fields!SumMoney)) & "元"
End If
Else
strSumMoney = ",无自由上机"
End If
lblList.Caption = strc_id & strFrom
lblList2.Caption = STRSumTime & strSumMoney
'*************************************************详细上机信息****************************
Set rsShangJi = New Recordset
rsShangJi.Open "select * from tbshangji" & where2, Modmain.conn, 3, 2
frmHourStatistic.AddLog ("L20") ''将用户统计上机情况的信息记入操作日志 ''
End Sub
Private Sub cmdList_Click()
frmCardholderList.StrForm = "frmShangjiStatistic"
frmCardholderList.Show 1
txtCH_ID.SetFocus
End Sub
Private Sub cmdPrint_Click()
If rsShangJi.RecordCount <> 0 Then
DRShangjiStatistic.Show 1
frmHourStatistic.AddLog ("L23") ''将用户打印上机统计结果的信息记入操作日志 ''
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
End Sub
Private Function where() As String '查询条件
Dim s As String
If txtCH_ID.Text <> "" Then
s = " and C_ID like '%" & Trim(txtCH_ID.Text) & "%'"
strc_id = txtCH_ID.Text
Else
strc_id = ""
End If
If DTPTo.Visible = False Then
If s <> "" Then
s = s & "and Date like '" & DTPFrom.Value & "'"
Else
s = " and 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 = " and 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
where = s
End Function
Private Function where2() 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
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
End If
where2 = s
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -