www.pudn.com > VB-KAOQINXITONG.zip > frmPubCardDetail.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 = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{CFBDEFBA-4F23-11D7-910C-00000E55E64F}#5.0#0"; "BNListTree.ocx"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.2#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmPubCardDetail
Caption = "员工打卡设备时间查询"
ClientHeight = 6585
ClientLeft = 1320
ClientTop = 1050
ClientWidth = 10470
Icon = "frmPubCardDetail.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 6585
ScaleWidth = 10470
StartUpPosition = 2 '屏幕中心
Begin BNListTreeProj.BNListTree BNListTree1
Height = 330
Left = 840
TabIndex = 1
Top = 465
Width = 3780
_ExtentX = 6668
_ExtentY = 503
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
SizeLock = 0 'False
BarWidth = 136
Text = ""
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 150
Left = 165
TabIndex = 21
Top = 6360
Visible = 0 'False
Width = 5220
_ExtentX = 9208
_ExtentY = 265
_Version = 393216
Appearance = 0
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 270
Left = 0
TabIndex = 26
Top = 6315
Width = 10470
_ExtentX = 18468
_ExtentY = 476
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 17965
EndProperty
EndProperty
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 5580
Left = 90
TabIndex = 0
Top = 120
Width = 2940
Begin BNCtrlGroup.BNComboBox cobDevType
Height = 300
Left = 1050
TabIndex = 9
Top = 5115
Width = 1740
_ExtentX = 0
_ExtentY = 0
Text = "cobDevType"
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin BNCtrlGroup.BNComboBox cobCardType
Height = 300
Left = 1050
TabIndex = 8
Top = 4635
Width = 1740
_ExtentX = 0
_ExtentY = 0
Text = "cobCardType"
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin BNCtrlGroup.BNComboBox cobEmployee
Height = 300
Left = 750
TabIndex = 2
Top = 870
Width = 2040
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin BNCtrlGroup.BNComboBox cobDevice
Height = 300
Left = 1050
TabIndex = 7
Top = 4155
Width = 1740
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin MSComCtl2.DTPicker dptTime
BeginProperty DataFormat
Type = 1
Format = "HH:mm"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 4
EndProperty
Height = 300
Index = 0
Left = 1050
TabIndex = 5
Top = 3150
Width = 1740
_ExtentX = 3069
_ExtentY = 529
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 66387970
CurrentDate = 36495
MaxDate = 44196
MinDate = 36495
End
Begin MSComCtl2.DTPicker dptTime
BeginProperty DataFormat
Type = 1
Format = "HH:mm"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 4
EndProperty
Height = 300
Index = 1
Left = 1050
TabIndex = 6
Top = 3660
Width = 1740
_ExtentX = 3069
_ExtentY = 529
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 66387970
CurrentDate = 36495.9999884259
MaxDate = 44196
MinDate = 36495
End
Begin MSComCtl2.DTPicker dtpRange
Height = 285
Index = 0
Left = 180
TabIndex = 3
Top = 1830
Width = 2610
_ExtentX = 4604
_ExtentY = 503
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarBackColor= 14737632
Format = 66387968
CurrentDate = 36455
MaxDate = 44196
MinDate = 35431
End
Begin MSComCtl2.DTPicker dtpRange
Height = 285
Index = 1
Left = 180
TabIndex = 4
Top = 2655
Width = 2610
_ExtentX = 4604
_ExtentY = 503
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarBackColor= 14737632
Format = 66387968
CurrentDate = 36455
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "设备类别:"
Height = 180
Index = 5
Left = 180
TabIndex = 27
Top = 5175
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "打卡类别:"
Height = 180
Index = 4
Left = 180
TabIndex = 25
Top = 4695
Width = 810
End
Begin VB.Line Line1
BorderColor = &H80000010&
Index = 1
X1 = 45
X2 = 2910
Y1 = 1305
Y2 = 1305
End
Begin VB.Line Line1
BorderColor = &H8000000E&
Index = 0
X1 = 30
X2 = 2910
Y1 = 1320
Y2 = 1320
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "结束时间:"
Height = 180
Index = 3
Left = 180
TabIndex = 24
Top = 3765
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "机构:"
Height = 180
Index = 6
Left = 180
TabIndex = 23
Top = 405
Width = 450
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "人员:"
Height = 180
Index = 7
Left = 180
TabIndex = 22
Top = 900
Width = 450
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "起始时间:"
Height = 180
Index = 2
Left = 180
TabIndex = 20
Top = 3225
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "系统设备:"
Height = 180
Index = 1
Left = 180
TabIndex = 19
Top = 4230
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "开始日期:"
Height = 180
Index = 8
Left = 180
TabIndex = 18
Top = 1590
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "结束日期:"
Height = 180
Index = 0
Left = 180
TabIndex = 17
Top = 2385
Width = 810
End
End
Begin MSDataGridLib.DataGrid grdDataGrid
Height = 5475
Left = 3075
TabIndex = 10
Top = 225
Width = 7260
_ExtentX = 12806
_ExtentY = 9657
_Version = 393216
AllowUpdate = 0 'False
BackColor = 14737632
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin BNCtrlGroup.BNButton cmdExit
Cancel = -1 'True
Height = 345
Left = 9180
TabIndex = 16
Top = 5790
Width = 1125
_ExtentX = 1984
_ExtentY = 609
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 cmdReport
Height = 345
Index = 0
Left = 6235
TabIndex = 15
Top = 5790
Width = 1125
_ExtentX = 1984
_ExtentY = 609
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 cmdReport
Height = 345
Index = 1
Left = 2780
TabIndex = 13
Top = 5790
Width = 1695
_ExtentX = 2990
_ExtentY = 609
Caption = "导出EXCEL"
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 cmdRefresh
Default = -1 'True
Height = 345
Left = 1585
TabIndex = 12
Top = 5790
Width = 1050
_ExtentX = 1852
_ExtentY = 609
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 cmdSearch
Height = 345
Left = 150
TabIndex = 11
Top = 5790
Width = 1290
_ExtentX = 2275
_ExtentY = 609
Caption = "查找(^F)"
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 cmdOutput
Height = 345
Left = 4620
TabIndex = 14
Top = 5790
Width = 1470
_ExtentX = 2593
_ExtentY = 609
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 cmdFind
Height = 345
Index = 0
Left = 7505
TabIndex = 28
Tag = "See"
Top = 5790
Width = 1530
_ExtentX = 2699
_ExtentY = 609
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
End
Attribute VB_Name = "frmPubCardDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'人员打卡时间查看
'本模块需要改进:
' 对设备的分类要重新考虑,即在函数CBNFillDeviceCombo中要重新定义设备的种类,使其为可多种用途
' 如某设备,既可做考勤也可做门禁,则该设备应该是复合种类,在SQL的查询中也应该做考虑
Option Explicit
Dim mTDateRange As DateRange
Dim mTGridFormat() As GridFormat
Dim mbModCardTime As Boolean
Dim mvValue() As Variant
Dim msManList As String
Dim mbSelectManual As Boolean
Dim WithEvents adoCardData As ADODB.Recordset
Attribute adoCardData.VB_VarHelpID = -1
Public pbSpecCard As Boolean '特卡显示
Public pbAttRptGroup As Boolean '报表分组
Private Type SpeCard
sClassID As String
DDate() As DateRange
End Type
Dim mTSpecCard() As SpeCard
Private Sub adoCardData_FieldChangeComplete(ByVal cFields As Long, _
ByVal Fields As Variant, _
ByVal pError As ADODB.Error, _
adStatus As ADODB.EventStatusEnum, _
ByVal pRecordset As ADODB.Recordset)
Dim i As Integer
Dim fld As ADODB.Field
For i = 1 To cFields
If Fields(i - 1).Name = "W0031" Then
If Not IsDate(Fields(i - 1).Value) Then
MsgBox "数据修改错误!"
adStatus = adStatusCancel
End If
End If
gclsCommon.CBNSaveEvents OET_QUERY_OPTION, _
"打卡查询,改变" & Fields(i - 1).Name & ":从" & mvValue(i - 1) & "到:" & Fields(i - 1).Value
Next i
End Sub
Private Sub adoCardData_WillChangeField(ByVal cFields As Long, _
ByVal Fields As Variant, _
adStatus As ADODB.EventStatusEnum, _
ByVal pRecordset As ADODB.Recordset)
ReDim mvValue(cFields - 1)
Dim i As Integer
Dim sName As String
For i = 0 To cFields - 1
mvValue(i) = Fields(i).Value
Next i
End Sub
Private Sub adoCardData_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, _
ByVal cRecords As Long, _
adStatus As ADODB.EventStatusEnum, _
ByVal pRecordset As ADODB.Recordset)
On Error GoTo ErrLabel
If adReason = adRsnDelete Then
If MsgBox("真的要删除此记录吗?", vbOKCancel + vbQuestion) = vbCancel Then
adStatus = adStatusCancel
End If
gclsCommon.CBNSaveEvents OET_QUERY_OPTION, _
"打卡查询,删除打卡数据:" & pRecordset.Fields("A0189") & "," & pRecordset.Fields("W0031")
End If
Exit Sub
ErrLabel:
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdFind_Click(Index As Integer)
Dim sSQL As String
Dim sField As String
Dim sDeptSQL As String
Dim bCancle As Boolean
Dim sRet As String
sRet = Switch(Index = 0, gTPickStruct.TempNumberLists, _
Index = 1, gTPickStruct.TempNameLists)
sField = Switch(Index = 0, "A0189", Index = 1, "A0101")
sSQL = gclsCommon.CBNShowSearchWindows(sField, , bCancle, , sRet, sRet)
If sSQL <> "" Then
If sRet <> "" Then
If Index = 0 Then
gTPickStruct.TempNumberLists = sRet
ElseIf Index = 1 Then
gTPickStruct.TempNameLists = sRet
End If
End If
BNListTree1.Text = ""
LoListEmployee "", "", sSQL
mbSelectManual = True
Else
If bCancle Then
StatusBar1.Panels(1).Text = "未输入有效的人员"
Else
MsgBox "未输入有效的人员", vbCritical
End If
End If
End Sub
Private Sub cmdSearch_Click()
Dim sEmpNum As String
Dim sDptNo As String
Dim sUnit As String
On Error Resume Next
Me.Hide
sEmpNum = gclsInclude.MyInputBox("请输入须定位的人员号", "查找人员", gTPickStruct.TempEmp)
Me.Show
If sEmpNum <> "" Then
If Not gclsCommon.CBNCheckEmplyRight Then Exit Sub
With gclsCommon.adoMemberRS
.Filter = "A0189 = '" & sEmpNum & "'"
If .RecordCount > 0 Then
sDptNo = gclsInclude.MyNz(!B0110)
sUnit = gclsInclude.MyNz(!E0122)
BNListTree1.Text = sUnit
LoListEmployee sUnit, sDptNo
cobEmployee = !A0189 & SPLIT_SYMBOL & gclsInclude.MyNz(!A0101)
Else
MsgBox "未查找到编号为" & sEmpNum & "的人员!", vbExclamation
End If
End With
End If
End Sub
Private Sub cobDevType_Click()
With cobDevice
.Clear
.AddItem VALUE_ALL_STR
.ItemData(.NewIndex) = 0
gclsCommon.CBNFillDeviceCombo cobDevice, _
IIf(cobDevType = "缺省设备", _
gTAppLicInfo.DevMainType, _
gclsCommon.CBNGetFirstData(cobDevType)), , , _
gTAppLicInfo.CtrlAutoDownload Or gTAppLicInfo.CtrlAutoRight
.ListIndex = 0
End With
End Sub
Private Sub dptTime_Change(Index As Integer)
dtpRange_Click Index
End Sub
Private Sub dptTime_Click(Index As Integer)
dtpRange_Click Index
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim bCtrlDown As Boolean
bCtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = Asc("F") Then 'CTRL+F
If bCtrlDown Then
cmdSearch_Click
End If
End If
End Sub
Private Sub cmdOutput_Click()
Dim iReplace As Integer
Dim iFilenum As Integer
Dim sFileName As String
Dim l As Long
On Error GoTo ExitSub
If adoCardData.RecordCount = 0 Then
MsgBox "无保存数据!"
Exit Sub
End If
sFileName = gclsInclude.MyGetFileName(False, "卡数据文件 (*.TXT)|*.TXT", "TXT", "CardData", , Me.hwnd)
If sFileName <> "" Then
iFilenum = FreeFile
Open sFileName For Output As iFilenum
Else
Exit Sub
End If
Set grdDataGrid.DataSource = Nothing
With adoCardData
.MoveFirst
Print #iFilenum, "人员编号,打卡时间,设备号,出入标志"
ProgressBar1.Max = .RecordCount
ProgressBar1.Visible = True
For l = 1 To .RecordCount
ProgressBar1.Value = l
Print #iFilenum, Val(!A0189) & "," & !W0031 & "," & !W1001 & "," & !W1002
.MoveNext
Next l
ProgressBar1.Visible = False
End With
Set grdDataGrid.DataSource = adoCardData
MsgBox "文件被保存为" & sFileName
ExitSub:
If grdDataGrid.DataSource Is Nothing Then
Set grdDataGrid.DataSource = adoCardData
End If
Close #iFilenum
End Sub
Private Sub cmdRefresh_Click()
Dim sSQL As String
Dim DBegin As Date
Dim adoTempRS As ADODB.Recordset
Dim sClassPlan() As String
Dim TFieldStruct() As FieldStruct
Dim l As Long
Dim m As Long
Dim n As Long
Dim k As Long
Dim lIndex As Long
Dim lClassIndex As Long
Dim DDate As Date
Dim sTemp As String
Dim bFlag As Boolean
On Error GoTo ErrLabel
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
If Not IsValidSQL(BNListTree1.UnitList, _
BNListTree1.DeptList, _
cobEmployee, _
mTDateRange.DStart, _
mTDateRange.DEnd, _
cobEmployee.ListCount) Then Exit Sub
DBegin = Now
sSQL = LoGetSQL
Set adoCardData = New ADODB.Recordset
If mbModCardTime Then
adoCardData.Open sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
Else
adoCardData.Open sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
End If
StatusBar1.Panels(1).Text = "共耗时：" & DateDiff("s", DBegin, Now) & "秒"
Set grdDataGrid.DataSource = adoCardData.DataSource
Screen.MousePointer = vbDefault
If adoCardData.RecordCount = 0 Then MsgBox "未查询到打卡数据"
Exit Sub
ErrLabel:
If Err = -2147467259 Then
MsgBox "SQL查询超时!"
Screen.MousePointer = vbDefault
Else
MsgBox Err.Description
Resume Next
End If
End Sub
Public Function LoGetClassIndex(ByVal fsClassID As String) As Integer
On Error GoTo ErrLabel
Dim i As Integer
For i = 1 To UBound(mTSpecCard)
If mTSpecCard(i).sClassID = fsClassID Then
LoGetClassIndex = i
Exit Function
End If
Next i
LoGetClassIndex = -1
Exit Function
ErrLabel:
End Function
Private Function LoGetSQL() As String
Dim sStr As String
Dim sDev As String
Dim sDept As String
Dim i As Integer
If Not (gTAppLicInfo.SysLoginSA Or gTAppLicInfo.SysLoginSYS) Then _
sDev = gclsCommon.CBNGetCondiSQL(gTOperRight.DevRight, "W1001", "")
sStr = gclsCommon.CBNGetFirstData(cobCardType)
sStr = Switch(sStr = VALUE_ALL_STR, "", sStr = "1", " AND (A0199 <> '-1')", sStr = "2", " AND (A0199 = '-1')")
If mbModCardTime Then
'使用子查询
sDept = gclsCommon.CBNGetCondition(BNListTree1.UnitList, _
BNListTree1.DeptList, _
IIf(cobEmployee = VALUE_ALL_STR, _
gclsCommon.CBNGetComboList(cobEmployee), _
cobEmployee))
If sDept <> "" Then sDept = "WHERE A0189 IN (SELECT A0189 FROM A001A001 WHERE " & sDept & ")"
LoGetSQL = gclsCommon.CBNGetCondition("", "", "", "W0031", mTDateRange.DStart, mTDateRange.DEnd)
LoGetSQL = LoGetSQL & " AND " & IIf(cobDevice = VALUE_ALL_STR, sDev, "W1001 =" & gclsCommon.CBNGetFirstData(cobDevice)) & sStr
If Right(LoGetSQL, 4) = "AND " Then LoGetSQL = Left(LoGetSQL, Len(LoGetSQL) - 5)
LoGetSQL = "SELECT A0189,W1001,W0031,W1002,W1028 FROM T0109A001 " & _
IIf(sDept = "", "", sDept) & _
IIf(LoGetSQL = "", "", IIf(sDept = "", " WHERE ", " AND ") & LoGetSQL & " ") & " ORDER BY A0189,W0031"
Else
'使用连接
LoGetSQL = gclsCommon.CBNGetCondition(BNListTree1.UnitList, _
BNListTree1.DeptList, _
IIf(cobEmployee = VALUE_ALL_STR, _
gclsCommon.CBNGetComboList(cobEmployee), _
cobEmployee), _
"W0031", _
mTDateRange.DStart, mTDateRange.DEnd)
LoGetSQL = LoGetSQL & " AND " & IIf(cobDevice = VALUE_ALL_STR, sDev, "W1001 =" & gclsCommon.CBNGetFirstData(cobDevice)) & sStr
If Right(LoGetSQL, 4) = "AND " Then LoGetSQL = Left(LoGetSQL, Len(LoGetSQL) - 5)
LoGetSQL = "SELECT A0189,W1001,W0031,W1002,W1028 FROM QT0109A001_001 " & _
IIf(LoGetSQL = "", "", " WHERE " & LoGetSQL) & " ORDER BY A0189,W0031"
End If
LoGetSQL = gclsCommon.CBNCSql(LoGetSQL)
#If APPLICATION_TYPE = 1 Then '考勤
i = InStr(1, LoGetSQL, "WHERE")
If i > 0 Then
sStr = Left(LoGetSQL, i + 5)
If pbSpecCard Then
LoGetSQL = sStr & "((W1113 IS NULL) OR (W1113 <> '1' AND W1113 <> '3')) AND " & Mid(LoGetSQL, i + 6)
Else
LoGetSQL = sStr & "((W1113 IS NULL) OR (W1113 <> '3' AND W1113 <> '4')) AND " & Mid(LoGetSQL, i + 6)
End If
End If
LoGetSQL = Replace(LoGetSQL, " AND AND ", " AND ")
#End If
End Function
Private Sub cmdReport_Click(Index As Integer)
Dim l As Long
Dim lID As Long
Dim i As Integer
Dim bUpdate As Boolean
Dim sSQL As String
Dim sCaption As String
Dim sFileName As String
If adoCardData Is Nothing Then Exit Sub
Dim adoCardDetailRS As ADODB.Recordset
Dim adoCardDataClone As ADODB.Recordset
Dim sFieldList As String
Dim oObj As Object
If adoCardData.RecordCount = 0 Then
MsgBox "本单位无打卡数据!请先按刷新键!": Exit Sub
End If
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
Set adoCardDetailRS = New ADODB.Recordset
Set adoCardDataClone = adoCardData.Clone
With adoCardDetailRS
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM T6629A001")
.Open "SELECT * FROM T6629A001", gDBRecordConn, adOpenStatic, adLockOptimistic
adoCardDataClone.MoveFirst
For l = 1 To adoCardDataClone.RecordCount
bUpdate = False
.Filter = "A0189= '" & adoCardDataClone!A0189 & "'"
If .EOF Then
AddNewLabel:
.AddNew
lID = lID + 1
!ID = lID
!A0189 = adoCardDataClone!A0189
!W6620 = gclsInclude.MyDateOf(adoCardDataClone!W0031)
bUpdate = True
Else
If .RecordCount > 0 Then
.Find gclsCommon.CBNCSql("W6620 = #" & gclsCommon.CBNGetStandDate(adoCardDataClone!W0031) & "#")
If .EOF Then GoTo AddNewLabel
End If
End If
For i = 1 To 8
If IsNull(.Fields("C663" & i)) Then
.Fields("C663" & i) = gclsInclude.MyTimeOf(adoCardDataClone!W0031)
Exit For
End If
Next i
If bUpdate Then .Update
adoCardDataClone.MoveNext
Next l
.Update
.Close
.Filter = 0
sFieldList = LoGetSQLFields
sSQL = "SHAPE {SELECT DISTINCT A0189 FROM T6629A001 ORDER BY A0189} AS ParentCMD APPEND " & _
"({SELECT " & sFieldList & " FROM QT6629A001_001 ORDER BY A0189,W6620} AS ChildCmd RELATE A0189 TO A0189) AS ChildCMD"
.Open sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
End With
Screen.MousePointer = vbNormal
Select Case Index
Case 0
If Not SetPrintPaple(0) Then Exit Sub
For Each oObj In rptCardData.Sections("SectionDetail").Controls
If TypeName(oObj) = "RptTextBox" Then
If Len(oObj.DataField) > 0 Then
oObj.DataMember = "ChildCmd"
End If
End If
Next
With rptCardData
If pbAttRptGroup Then
.Sections("Section2").Height = 10
.Sections("Section2").ForcePageBreak = rptPageBreakAfter
Else
.Sections("Section2").ForcePageBreak = rptPageBreakNone
End If
Set .DataSource = adoCardDetailRS
.Show IIf(gTAppLicInfo.CtrlRunSingle, vbModal, vbModeless)
End With
Case 1
For i = 0 To UBound(mTGridFormat)
If mTGridFormat(i).sCaption <> "" Then
sCaption = sCaption & mTGridFormat(i).sCaption & SPLIT_SYMBOL
End If
Next i
If sCaption <> "" Then
sCaption = Left(sCaption, Len(sCaption) - 1)
End If
sFileName = gclsInclude.MyGetFileName(False, _
"Excel (*.xls)|*.xls", _
"xls", _
gTAppLicInfo.FilePathApp & "Report\人员打卡报表", _
Me.hwnd)
If sFileName <> "" Then
gclsCommon.CBNOutputDBase adoCardDetailRS, _
sFileName, _
SPLIT_SYMBOL, _
sCaption, _
"人员打卡报表"
MsgBox "文件被保存为: " & sFileName
End If
End Select
End Sub
Private Function LoGetSQLFields() As String
Dim sSQLStr As String
Dim i As Integer
ReDim mTGridFormat(10)
mTGridFormat(0).sField = "A0189"
mTGridFormat(1).sField = "A0101"
mTGridFormat(2).sField = "W6620"
For i = 1 To 8
mTGridFormat(i + 2).sField = "C663" & i
Next i
For i = 0 To UBound(mTGridFormat)
If mTGridFormat(i).sField <> "" Then
sSQLStr = sSQLStr & mTGridFormat(i).sField & ","
End If
Next i
sSQLStr = Left(sSQLStr, Len(sSQLStr) - 1)
LoGetSQLFields = sSQLStr
End Function
Private Sub dtpRange_Click(Index As Integer)
Select Case Index
Case 0
mTDateRange.DStart = CDate(gclsInclude.MyDateOf(dtpRange(Index).Value) & " " & gclsInclude.MyTimeOf(dptTime(Index)))
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DStart
dptTime(1 - Index).Value = gclsInclude.MyDateOf(dptTime(1 - Index).Value) & " " & gclsInclude.MyTimeOf(mTDateRange.DStart)
mTDateRange.DEnd = mTDateRange.DStart
End If
Case 1
mTDateRange.DEnd = CDate(gclsInclude.MyDateOf(dtpRange(Index).Value) & " " & gclsInclude.MyTimeOf(dptTime(Index)))
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = mTDateRange.DEnd
dptTime(1 - Index).Value = gclsInclude.MyDateOf(dptTime(1 - Index).Value) & " " & gclsInclude.MyTimeOf(mTDateRange.DEnd)
mTDateRange.DStart = mTDateRange.DEnd
End If
End Select
End Sub
Private Sub dtpRange_Change(Index As Integer)
dtpRange_Click Index
End Sub
Private Sub Form_Load()
On Error GoTo ErrLabel
Dim i As Integer
Dim n As Integer
Dim sSplit
LoSetButtonTag
SetIcon Me
gclsInclude.MyShowPbrInSbr ProgressBar1, StatusBar1.hwnd, 1
mbModCardTime = Mid(gTOperRight.OtherRight, 3, 1) = "1"
grdDataGrid.AllowUpdate = mbModCardTime
grdDataGrid.AllowDelete = mbModCardTime
grdDataGrid.AllowAddNew = False
BNListTree1.RefuseDeptList = gTOperRight.RefuseDeptRight
gclsCommon.CBNFillBNListTree BNListTree1
LoadPickStruct BNListTree1, mTDateRange, cobEmployee
mTDateRange.DEnd = CDate(gclsInclude.MyDateOf(mTDateRange.DEnd) & " 23:59:59")
dtpRange(0).Value = mTDateRange.DStart
dtpRange(1).Value = mTDateRange.DEnd
#If APPLICATION_TYPE = 1 Then '考勤
#End If
'
' cobDevice.Clear
' cobDevice.AddItem VALUE_ALL_STR
' cobDevice.ItemData(cobDevice.NewIndex) = 0
' gclsCommon.CBNFillDeviceCombo cobDevice, gTAppLicInfo.DevMainType, , , gTAppLicInfo.CtrlAutoDownload Or gTAppLicInfo.CtrlAutoRight
' cobDevice.ListIndex = 0
cobCardType.AddItem VALUE_ALL_STR
cobCardType.AddItem "1" & SPLIT_SYMBOL & "正常打卡"
cobCardType.AddItem "2" & SPLIT_SYMBOL & "手工签卡"
cobCardType.ListIndex = 0
cobDevType.AddItem "缺省设备"
For i = 0 To 10
cobDevType.AddItem 2 ^ i & SPLIT_SYMBOL & gclsInclude.MyGetDevApp(2 ^ i)
Next i
cobDevType.ListIndex = 0
cobDevType.Enabled = False
Label4(5).Enabled = False
Dim TGridFormat(4) As GridFormat
TGridFormat(0).sField = "A0189"
TGridFormat(1).sField = "W1001"
TGridFormat(2).sField = "W0031"
TGridFormat(3).sField = "W1002"
TGridFormat(4).sField = "W1028"
gclsCommon.CBNSetGridFormat grdDataGrid, TGridFormat, , Me, "T0109A001"
grdDataGrid.Columns(0).Locked = True
grdDataGrid.Columns(1).Locked = True
Exit Sub
ErrLabel:
MsgBox "发生错误,错误号 = " & Err & ",错误原因 = " & Err.Description & ",错误模块=FormLoad"
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
SavePickStruct BNListTree1, mTDateRange, cobEmployee
Set adoCardData = Nothing
End Sub
Private Sub LoListEmployee(ByVal fsUnitNo As String, _
ByVal fsDeptNo As String, _
Optional fsEmpList As String)
cobEmployee.Clear
cobEmployee.AddItem VALUE_ALL_STR
cobEmployee.ItemData(cobEmployee.NewIndex) = 0
StatusBar1.Panels(1).Text = "正在加载人员数据"
DoEvents
If Len(fsEmpList) > 0 Then
gclsCommon.CBNFillEmpCombo cobEmployee, "", "", fsEmpList
ElseIf 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 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 LoSetButtonTag()
cmdExit.Tag = "IMG029"
cmdReport(0).Tag = "IMG031"
cmdReport(1).Tag = "IMG027"
cmdRefresh.Tag = "IMG040"
cmdSearch.Tag = "IMG031"
cmdOutput.Tag = "IMG022"
cmdFind(0).Tag = "IMG031"
DoEvents
End Sub