www.pudn.com > VB-KAOQINXITONG.zip > frmCardTotal.frm
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.0#0"; "BNCtrlGroup.ocx"
Object = "{CFBDEFBA-4F23-11D7-910C-00000E55E64F}#5.0#0"; "BNListTree.ocx"
Begin VB.Form frmCardTotal
Caption = "IC打卡统计"
ClientHeight = 4335
ClientLeft = 60
ClientTop = 345
ClientWidth = 5910
Icon = "frmCardTotal.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4335
ScaleWidth = 5910
StartUpPosition = 2 '屏幕中心
Begin BNListTreeProj.BNListTree BNListTree1
Height = 330
Left = 1710
TabIndex = 1
Top = 270
Width = 4020
_ExtentX = 7091
_ExtentY = 582
BeginProperty ToolTipFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TreeHeight = 211
TreeVisible = 0 'False
ShowName = -1 'True
Text = ""
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 4020
Left = 30
TabIndex = 0
Top = -60
Width = 5865
Begin VB.CheckBox chkMoning
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "早班天数统计"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 5
Top = 2850
Width = 3345
End
Begin VB.CheckBox chkCost
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "饭堂消费金额统计"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 7
Top = 3540
Width = 3345
End
Begin VB.CheckBox chkNight
Alignment = 1 'Right Justify
Appearance = 0 'Flat
Caption = "夜班天数统计"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 6
Top = 3195
Width = 3345
End
Begin BNCtrlGroup.BNComboBox cobEmployee
Height = 330
Left = 1680
TabIndex = 2
Top = 845
Width = 4020
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 0
Left = 1680
TabIndex = 3
Top = 1390
Width = 4020
_ExtentX = 7091
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarBackColor= 14737632
Format = 68681728
CurrentDate = 36455
MaxDate = 44196
MinDate = 35796
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 1
Left = 1680
TabIndex = 4
Top = 1935
Width = 4020
_ExtentX = 7091
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarBackColor= 14737632
Format = 68681728
CurrentDate = 36455
MaxDate = 44196
MinDate = 35796
End
Begin BNCtrlGroup.BNButton cmdOutput
Default = -1 'True
Height = 360
Index = 1
Left = 4245
TabIndex = 8
Tag = "Start"
Top = 2865
Width = 1350
_ExtentX = 2381
_ExtentY = 635
Caption = "计 算"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin BNCtrlGroup.BNButton cmdExit
Cancel = -1 'True
Height = 360
Left = 4245
TabIndex = 9
Tag = "Exit"
Top = 3420
Width = 1350
_ExtentX = 2381
_ExtentY = 635
Caption = "退 出"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "结束日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 555
TabIndex = 13
Top = 1995
Width = 945
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "开始日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 555
TabIndex = 12
Top = 1450
Width = 945
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "机 构:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 555
TabIndex = 11
Top = 390
Width = 630
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "人 员:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 555
TabIndex = 10
Top = 905
Width = 630
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderStyle = 6 'Inside Solid
Index = 0
X1 = 30
X2 = 5850
Y1 = 2655
Y2 = 2655
End
Begin VB.Line Line1
BorderColor = &H80000016&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 45
X2 = 5865
Y1 = 2670
Y2 = 2670
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 150
Left = 30
TabIndex = 14
Top = 180
Visible = 0 'False
Width = 3315
_ExtentX = 5847
_ExtentY = 265
_Version = 393216
Appearance = 1
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 15
Top = 4005
Width = 5910
_ExtentX = 10425
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 10001
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmCardTotal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoReportRS As ADODB.Recordset
Dim adoRsltRS As ADODB.Recordset
Dim mTDateRange As DateRange
Dim msCondition As String
Private Sub cmdOutput_Click(Index As Integer)
Dim sSQL As String
Dim l As Long
Dim iAddr As Integer
Dim lID As Long
Dim lMaxID As Long
Dim sQuery As String
If chkCost + chkMoning + chkNight = 0 Then
MsgBox "请选择统计项", vbExclamation: Exit Sub
End If
If Not IsValidSQL(BNListTree1.UnitList, BNListTree1.DeptList, cobEmployee, mTDateRange.DStart, mTDateRange.DEnd, cobEmployee.ListCount) Then Exit Sub
If chkCost = 1 Then
msCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, _
BNListTree1.DeptList, _
cobEmployee, _
"W0031", _
dtpRange(0), _
dtpRange(1) + 1)
sSQL = "SELECT A0100, SUM(W1038) AS SUM_W1038, B0110, E0122 FROM QT0109A001_002 " & _
IIf(msCondition <> "", "WHERE " & msCondition, "") & _
" GROUP BY A0100, B0110, E0122"
Set adoRsltRS = New ADODB.Recordset
adoRsltRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
sSQL = "SELECT ID,A0100,W5837,W5830,B0110 FROM A058A001"
Set adoReportRS = New ADODB.Recordset
adoReportRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
If adoRsltRS.RecordCount > 0 Then
ProgressBar1.Max = adoRsltRS.RecordCount
ProgressBar1.Visible = True
For l = 1 To adoRsltRS.RecordCount
ProgressBar1.Value = l
If adoRsltRS!A0100 <> "" Then
adoReportRS.Filter = "A0100 ='" & adoRsltRS!A0100 & "'"
If adoReportRS.RecordCount = 0 Then
lID = 100
adoReportRS.AddNew
Else
lID = adoReportRS!ID
End If
adoReportRS!A0100 = adoRsltRS!A0100
adoReportRS!W5837 = adoRsltRS!SUM_W1038 / 100
adoReportRS!B0110 = adoRsltRS!B0110
adoReportRS!ID = lID
adoReportRS.Update
adoRsltRS.MoveNext
End If
Next l
Else
MsgBox "当前范围内无用膳数据"
End If
End If
If chkMoning = 1 Then
StatusBar1.Panels(1).Text = "正在统计早班天数"
DoEvents
LoTotalClass 0 '早班统计
End If
If chkNight = 1 Then
StatusBar1.Panels(1).Text = "正在统计夜班天数"
DoEvents
LoTotalClass 1 '夜班统计
End If
ProgressBar1.Visible = False
StatusBar1.Panels(1).Text = "统计完毕"
End Sub
Private Sub LoTotalClass(fiFlag As Integer)
Dim sSQL As String
Dim sField As String
Dim sTimePot As String
Dim adoRsltRS As ADODB.Recordset
Dim l As Long
sSQL = GetQueriyItem("QT6621A001_004")
If fiFlag = 0 Then '早班统计
sTimePot = Round(gTAttendCtl.MorningTimePot, 2)
sField = "W6622" '早班天数
ElseIf fiFlag = 1 Then '夜班统计
sTimePot = Round(gTAttendCtl.NightTimePot, 2)
sField = "W6624" '夜班天数
End If
sSQL = Replace(sSQL, "'TIME_ERR'", sTimePot)
msCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, cobEmployee, "T6621A001.E6600", dtpRange(0) - 1, dtpRange(1))
If msCondition <> "" Then
msCondition = Replace(msCondition, "B0110", "A001A001.B0110")
msCondition = Replace(msCondition, "E0122", "A001A001.E0122")
msCondition = Replace(msCondition, "A0189", "A001A001.A0189")
l = InStr(sSQL, "WHERE ")
If l > 0 Then
sSQL = Left(sSQL, l + 5) & "(" & Trim(msCondition) & ") AND " & Mid(sSQL, l + 6)
End If
End If
Set adoRsltRS = New ADODB.Recordset
adoRsltRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
If adoRsltRS.RecordCount > 0 Then
ProgressBar1.Max = adoRsltRS.RecordCount
ProgressBar1.Visible = True
sSQL = "SELECT ID,A0100," & sField & " FROM A066A001 "
Set adoReportRS = New ADODB.Recordset
adoReportRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
For l = 1 To adoRsltRS.RecordCount
ProgressBar1.Value = l
adoReportRS.Filter = "A0100='" & adoRsltRS!A0100 & "'"
If adoReportRS.RecordCount > 0 Then
adoReportRS.Fields(sField) = adoRsltRS!COUNT_A0100
adoReportRS.Update
End If
adoRsltRS.MoveNext
Next l
adoRsltRS.Close
Else
MsgBox "当前范围内无" & IIf(fiFlag = 0, "早", "夜") & "班数据"
End If
End Sub
Private Sub Form_Load()
Dim adoTempRS As ADODB.Recordset
Dim i As Integer
LoSetButtonTag
SetIcon Me
BNListTree1.RefuseDeptList = gTOperRight.RefuseDeptRight
gclsCommon.CBNFillBNListTree BNListTree1
gclsInclude.MyShowPbrInSbr ProgressBar1, StatusBar1.hwnd, 1
LoadPickStruct BNListTree1, mTDateRange, cobEmployee
dtpRange(0).Value = mTDateRange.DStart
dtpRange(1).Value = mTDateRange.DEnd
End Sub
Private Sub BNListTree1_NodeSelect(ByVal UnitLists As String, ByVal DeptLists As String)
If Len(UnitLists) + Len(DeptLists) = 0 Then Exit Sub
LoListEmployee UnitLists, DeptLists
End Sub
Private Sub LoListEmployee(ByVal fsUnitNo As String, ByVal fsDeptNo As String)
cobEmployee.Clear
cobEmployee.AddItem VALUE_ALL_STR
cobEmployee.ItemData(cobEmployee.NewIndex) = 0
StatusBar1.Panels(1).Text = "正在加载员工数据"
DoEvents
If Len(fsUnitNo) + Len(fsDeptNo) > 0 Then
gclsCommon.CBNFillEmpCombo cobEmployee, fsUnitNo, fsDeptNo
End If
If cobEmployee.ListCount > 0 Then cobEmployee.ListIndex = 0
StatusBar1.Panels(1).Text = "加载员工数据完毕"
End Sub
Private Sub dtpRange_Change(Index As Integer)
dtpRange_Click Index
End Sub
Private Sub dtpRange_Click(Index As Integer)
Select Case Index
Case 0
mTDateRange.DStart = dtpRange(Index).Value
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DStart
mTDateRange.DEnd = mTDateRange.DStart
End If
Case 1
mTDateRange.DEnd = dtpRange(Index).Value + 1
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DEnd
mTDateRange.DStart = mTDateRange.DEnd
End If
End Select
SavePickStruct BNListTree1, mTDateRange, cobEmployee
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Set adoReportRS = Nothing
Set adoRsltRS = Nothing
End Sub
Private Sub LoSetButtonTag()
cmdOutput(1).Tag = "IMG013"
cmdExit.Tag = "IMG029"
End Sub