www.pudn.com > VB-KAOQINXITONG.zip > frmPubRptSelect.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 = "{CFBDEFBA-4F23-11D7-910C-00000E55E64F}#5.0#0"; "BNListTree.ocx"
Object = "{B9D938CE-50EE-40B2-9FA2-79A3112F4788}#4.2#0"; "BNCtrlGroup.ocx"
Begin VB.Form frmRptSelect
ClientHeight = 4275
ClientLeft = 2565
ClientTop = 2010
ClientWidth = 5880
Icon = "frmPubRptSelect.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4275
ScaleWidth = 5880
StartUpPosition = 2 '屏幕中心
Begin BNListTreeProj.BNListTree BNListTree1
Height = 330
Left = 1695
TabIndex = 1
Top = 225
Width = 4020
_ExtentX = 7091
_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
Text = ""
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 150
Left = 30
TabIndex = 16
Top = 4125
Visible = 0 'False
Width = 3315
_ExtentX = 5847
_ExtentY = 265
_Version = 393216
Appearance = 0
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 4020
Left = 15
TabIndex = 3
Top = -75
Width = 5865
Begin VB.Frame Frame2
BorderStyle = 0 'None
Height = 1155
Left = 60
TabIndex = 18
Top = 2730
Visible = 0 'False
Width = 3795
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "显示未巡到网点情况"
ForeColor = &H80000008&
Height = 270
Index = 2
Left = 285
TabIndex = 21
Top = 810
Visible = 0 'False
Width = 2790
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "显示有效巡更情况"
ForeColor = &H80000008&
Height = 270
Index = 1
Left = 285
TabIndex = 20
Top = 495
Value = -1 'True
Width = 2790
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "显示所有巡更情况"
ForeColor = &H80000008&
Height = 270
Index = 0
Left = 285
TabIndex = 19
Top = 165
Width = 2790
End
End
Begin BNCtrlGroup.BNComboBox cobOutput
Height = 300
Left = 180
TabIndex = 5
Top = 2880
Width = 3555
_ExtentX = 0
_ExtentY = 0
End
Begin BNCtrlGroup.BNComboBox cobEmployee
Height = 330
Left = 1680
TabIndex = 0
Top = 845
Width = 4020
_ExtentX = 0
_ExtentY = 0
BackColor = 14737632
BackColor = 14737632
BackColor = 14737632
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 0
Left = 1665
TabIndex = 2
Top = 1395
Width = 2115
_ExtentX = 3731
_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 = 68288512
CurrentDate = 36455
MaxDate = 44196
MinDate = 35796
End
Begin MSComCtl2.DTPicker dtpRange
Height = 330
Index = 1
Left = 1680
TabIndex = 4
Top = 1935
Width = 2115
_ExtentX = 3731
_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 = 68288512
CurrentDate = 36455
MaxDate = 44196
MinDate = 35796
End
Begin BNCtrlGroup.BNButton cmdOutput
Default = -1 'True
Height = 360
Index = 1
Left = 4275
TabIndex = 9
Tag = "See"
Top = 3150
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 = 4275
TabIndex = 10
Tag = "Exit"
Top = 3555
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 cmdOutput
Height = 360
Index = 0
Left = 180
TabIndex = 6
Tag = "Excel"
Top = 3420
Width = 1680
_ExtentX = 2963
_ExtentY = 635
Caption = "导出EXCEL"
CapAlign = 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 = 360
Index = 2
Left = 1950
TabIndex = 7
Tag = "Backup"
Top = 3405
Width = 1785
_ExtentX = 3149
_ExtentY = 635
Caption = "导出其他格式"
CapAlign = 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 = 360
Index = 3
Left = 4275
TabIndex = 8
Tag = "See"
Top = 2745
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 cmdFind
Height = 375
Index = 0
Left = 4095
TabIndex = 17
Tag = "See"
Top = 1913
Width = 1530
_ExtentX = 2699
_ExtentY = 661
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.Line Line3
BorderColor = &H00FFFFFF&
X1 = 3900
X2 = 3900
Y1 = 2685
Y2 = 4020
End
Begin VB.Line Line2
BorderColor = &H80000010&
X1 = 3885
X2 = 3885
Y1 = 2670
Y2 = 4020
End
Begin VB.Line Line1
BorderColor = &H80000016&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 45
X2 = 5865
Y1 = 2670
Y2 = 2670
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderStyle = 6 'Inside Solid
Index = 0
X1 = 30
X2 = 5850
Y1 = 2655
Y2 = 2655
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 = 14
Top = 905
Width = 630
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 = 13
Top = 405
Width = 630
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 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 = 11
Top = 1995
Width = 945
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 15
Top = 3945
Width = 5880
_ExtentX = 10372
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 9869
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmRptSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'员工个人出勤报表
Option Explicit
Dim madoReportRS As ADODB.Recordset
Dim madoRsltRS As ADODB.Recordset
Dim mTDateRange As DateRange
Dim mTFieldRec() As FieldRec
Dim msDesc As String
Public piMode As RUN_MODE
Dim mTHoliSystem() As HoliSystem
Dim msCondition As String
Dim mbError As Boolean
#If APPLICATION_TYPE = 1 Then '考勤
Private Sub LoCalculate()
Dim adoTempRS As ADODB.Recordset
Dim adoManRS As ADODB.Recordset
Dim sSQL As String
Dim lMaxID As Long
Dim sEmpNum As String
Dim sEmpList As String
Dim l As Long
Dim sin8 As Single
Dim sinTemp As Single
Dim iFlag As Integer
Dim i As Integer
Dim bFlag As Boolean
Dim iSaturdayCount As Integer
Dim sinRest As Single
On Error GoTo StopLabel
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
Set adoTempRS = New ADODB.Recordset
StatusBar1.Panels(1).Text = "正在删除历史数据"
sSQL = msCondition
sEmpList = gclsCommon.CBNGetFirstData(cobEmployee.Text)
If sEmpList = VALUE_ALL_STR Then
sEmpList = gclsCommon.CBNGetComboList(cobEmployee)
End If
gDBRecordConn.CommandTimeout = 500
If piMode = RPT_HOLIDAY Then
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM T6645A001 " & sSQL)
StatusBar1.Panels(1).Text = "正在加载当前数据"
adoTempRS.Open "SELECT * FROM T6645A001 " & sSQL, gDBRecordConn, adOpenStatic, adLockOptimistic
Set madoReportRS = New ADODB.Recordset
madoReportRS.Open "SELECT * FROM QT6645A001_001 " & sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
If madoReportRS.RecordCount > 0 Then
Do While Not madoReportRS.EOF
For l = 1 To 4
If gclsInclude.MyNz(madoReportRS.Fields("W664" & l)) <> "" Then
adoTempRS.AddNew
lMaxID = gclsCommon.CBNGetMaxID("T6645A001"): lMaxID = lMaxID + 1
With adoTempRS
!ID = lMaxID
!A0189 = madoReportRS!A0189
!B0110 = madoReportRS!B0110
!E0122 = madoReportRS!E0122
!W0010 = CDate(madoReportRS.Fields("W665" & l))
!W0020 = CDate(madoReportRS.Fields("W666" & l))
!W6640 = CDate(madoReportRS!W6640)
!W6671 = madoReportRS.Fields("W664" & l)
.Update
If lMaxID > 0 Then gclsCommon.CBNSetMaxID "T6645A001", lMaxID
End With
End If
Next l
madoReportRS.MoveNext
Loop
StatusBar1.Panels(1).Text = "加载完毕"
Else
StatusBar1.Panels(1).Text = ""
MsgBox "该范围内无请假数据"
End If
ElseIf piMode = RPT_DAY1 Then
StatusBar1.Panels(1).Text = "正在加载当前数据"
'将A066A001中有而A001A001中无的数据删除
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE A066A001.* FROM A066A001 WHERE A0189 IN ( SELECT A066A001.A0189 FROM A066A001 LEFT JOIN A001A001 ON ([A066A001].[B0110] = [A001A001].[B0110]) AND ([A066A001].[A0189] = [A001A001].[A0189]) WHERE ([A001A001].[A0189] Is Null));")
Set madoReportRS = New ADODB.Recordset
Set adoManRS = New ADODB.Recordset
If mbError Then '如果错误
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM A066A001 WHERE A0189 IS NULL OR A0189 =''")
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM A066A001 WHERE " & _
gclsCommon.CBNGetCondiSQL(gclsCommon.CBNGetEmpList(BNListTree1.UnitList, BNListTree1.DeptList), "A0189"))
mbError = False
Else
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM A066A001 WHERE " & _
gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList))
End If
madoReportRS.Open "SELECT TOP 1 * FROM A066A001 ORDER BY A0189", gDBRecordConn, adOpenStatic, adLockOptimistic
adoManRS.Open "SELECT DISTINCT A0189 FROM QT6621A001_002 " & sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
adoTempRS.Open "SELECT * FROM QT6621A001_002 " & sSQL & " ORDER BY E0122,A0189,E6600", gDBRecordConn, adOpenStatic, adLockReadOnly
If sSQL <> "" Then
sSQL = Replace(sSQL, "E6600", "(W6616")
l = InStr(sSQL, " BETWEEN")
'sSQL = sSQL & " OR (W6617" & Mid(sSQL, l) & ")"
'当前版本的工时调换必须保证在被计算的范围内有效,所以用AND
sSQL = sSQL & " AND (W6617" & Mid(sSQL, l) & ")"
End If
If adoTempRS.RecordCount > 0 Then
ProgressBar1.Max = adoManRS.RecordCount
ProgressBar1.Visible = True
StatusBar1.Panels(1).Text = "正在统计报表数据"
' 置鼠标忙标志
Screen.MousePointer = vbHourglass
l = 0
With madoReportRS
Do While Not adoManRS.EOF
l = l + 1
ProgressBar1.Value = l
sEmpNum = adoManRS!A0189
adoTempRS.Filter = "A0189 ='" & sEmpNum & "'"
If adoTempRS.RecordCount > 0 Then
.AddNew
!ID = 100
!A0100 = adoTempRS!A0100
!A0189 = adoTempRS!A0189
!W0075 = "1000000000"
!B0110 = adoTempRS!B0110
!E0122 = adoTempRS!E0122
!C6699 = 0
!E6601 = 0
!E6605 = 0 '应上天数
!E6613 = 0
!E6629 = 0
!E6631 = 0
!E6632 = 0
!E6689 = 0
!E6690 = 0
!W6621 = 0
sinRest = 0
iSaturdayCount = 0
iFlag = gclsInclude.MyNz(adoTempRS!A0187, 0)
sin8 = 0
InitAttendValue madoReportRS
Do While Not adoTempRS.EOF
'E6600 考勤登记日期
.Fields("C66" & (40 + Day(adoTempRS!E6600))) = adoTempRS!E6606 '考虑了迟到及早退以及有工时假
!C6616 = !C6616 + adoTempRS!C6616 '休日工时
!C6618 = !C6618 + adoTempRS!C6618 '法定假工时
!E6602 = !E6602 + adoTempRS!E6602 '应上工时
!E6604 = !E6604 + adoTempRS!E6604 '应上工时
!E6606 = !E6606 + adoTempRS!E6606
!E6609 = !E6609 + adoTempRS!E6609 '平日特卡工时
!E6610 = !E6610 + adoTempRS!E6610 '休日特卡工时
!E6611 = !E6611 + adoTempRS!E6611 '节假日特卡工时
!C6617 = !C6617 + adoTempRS!C6617
!E6635 = !E6635 + adoTempRS!E6635
If adoTempRS!C6617 >= gTAttendCtl.MustAddTime Then
!E6689 = !E6689 + gTAttendCtl.MustAddTime '定额加班
Else
!E6689 = !E6689 + adoTempRS!C6617 '定额加班
End If
!E6623 = !E6623 + adoTempRS!E6623 '旷工
!E6627 = !E6627 + adoTempRS!E6627
!E6630 = !E6630 + adoTempRS!E6630
!E6633 = !E6633 + adoTempRS!E6633
!E6636 = !E6636 + adoTempRS!E6636
'请假汇总
For i = 0 To UBound(gTHoliSystem)
.Fields(gTHoliSystem(i).W6671) = .Fields(gTHoliSystem(i).W6671) + adoTempRS.Fields(gTHoliSystem(i).W6671)
Next i
!E6679 = !E6679 + adoTempRS!E6679 '有工时假
!E6680 = !E6680 + adoTempRS!E6680 '无工时假
'统计休息天数
If gclsInclude.MyNz(adoTempRS!W6646, 0) And WK_FEAST Then
!E6601 = !E6601 + 1
sinRest = sinRest + adoTempRS!C6616
ElseIf gclsInclude.MyNz(adoTempRS!W6646, 0) And WK_REST Then
!E6631 = !E6631 + adoTempRS!E6626
!C6699 = !C6699 + adoTempRS!C6675
Else
!E6605 = !E6605 + 1
!E6629 = !E6629 + adoTempRS!E6626
End If
If gclsInclude.MyNz(adoTempRS!W6646, 0) And WK_SATURDAY Then
iSaturdayCount = iSaturdayCount + 1
If iSaturdayCount = 5 Then
!E6613 = adoTempRS!C6616 + adoTempRS!E6610 '休日工时+特卡工时
End If
End If
If adoTempRS!C6616 >= 8 Then
sin8 = sin8 + 8
Else
sin8 = sin8 + adoTempRS!C6616
End If
adoTempRS.MoveNext
Loop
!E6690 = !C6617 - !E6689 '额外加班
'C6616-休日工时
'C6617-日加班工时累计
'C6618-法定假工时
'E6604-应上工时
'E6606-出勤工时
'W6621-未补工时
'E6623-旷工工时
'E6630-加班段工时（即加班段的加班工时,区别于正班段的加班工时）
'E6632-总加班工时
'W6646-工作状态标志
'E6679-有工时假工时
If iFlag = 0 Then '0-无加班 ( 既无平日加班又无休日加班)
ElseIf iFlag = 1 Then '1-加班类型1 ( 平日加班及休日加班全计薪,但只计算超出应上工时的部分计加班)
sinTemp = !E6606 - !E6604
If gTAttendCtl.FeastRestToDay Then
sinTemp = sinTemp + sinRest - !C6616
End If
If sinTemp < 0 Then sinTemp = 0
!E6632 = sinTemp
ElseIf iFlag = 2 Then '2-加班类型2 ( 平日加班全计薪,休日加班全计薪)
!E6632 = !C6616 + !C6617 + !C6618
ElseIf iFlag = 3 Then '3-加班类型3 ( 无平日加班,休日加班全计薪)
!E6632 = !C6616
ElseIf iFlag = 4 Then '4-加班类型4 ( 无平日加班,休日加班全计补休)
!W6621 = !W6621 + !C6616
ElseIf iFlag = 5 Then '5-加班类型5 ( 平日加班全计薪,无休日加班)
!E6632 = !C6617 + !C6618
ElseIf iFlag = 6 Then '6-加班类型6 ( 平日加班全计薪,休日加班全部算补休)
!E6632 = !C6617 + !C6618
!W6621 = !W6621 + !C6616
ElseIf iFlag = 7 Then '7-加班类型7 ( 平日加班全计薪,休日加班8小时内算补休,超过8小时的部分计薪)
!E6632 = !C6617 + !C6618 + !C6616 - sin8
!W6621 = !W6621 + sin8
ElseIf iFlag = 8 Then '8-加班类型8 ( 平日加班和休日加班全计补休)
!W6621 = !C6617 + !C6618 + !C6616
ElseIf iFlag = 9 Then '9-加班类型9 ( 正班段加班计薪,加班段加班计补休)
!E6632 = !E6602 'E6602:日正班段加班
!W6621 = !W6621 + !E6630 + !E6635 + !E6609 'W6621:未补工时;E6630:加班段工时
End If
End If
Err.Clear
On Error GoTo ErrUpdate
.Update
ErrUpdate:
If Err = -2147217900 Then
Err.Clear
On Error GoTo StopLabel
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM A066A001 WHERE A0189 ='" & !A0189 & "'")
gDBRecordConn.Execute gclsCommon.CBNCSql("DELETE * FROM A066A001 WHERE A0100 ='" & !A0100 & "'")
.CancelUpdate
Err.Clear
mbError = True
End If
adoManRS.MoveNext
Loop
End With
ProgressBar1.Visible = False
StatusBar1.Panels(1).Text = "报表生成完毕"
Else
StatusBar1.Panels(1).Text = "无有效数据"
End If
End If
Screen.MousePointer = vbDefault
gDBRecordConn.CommandTimeout = 30
Exit Sub
StopLabel:
gclsCommon.CBNSaveLogFile Err.Description, True
If Err = 3265 Then
MsgBox Error & "请升级数据库系统!"
End If
Resume Next
Exit Sub
ErrLabel:
End Sub
Private Sub cmdOutput_Click(Index As Integer)
Dim sSQL As String
Dim FieldDesc As String
Dim sFields As String
Dim l As Long
Dim i As Integer
Dim sinTemp As Single
Dim sFileName As String
Dim rRpt
Dim TAttendDetail As AttendDetail
Dim iPaper As Integer
Dim lDeltaWidth As Long
Dim lWidth As Long
Dim lLeft As Long
Dim bTemp As Boolean
Dim sEmpList As String
On Error GoTo ErrorHandler:
mbError = False
If Not IsValidSQL(BNListTree1.UnitList, BNListTree1.DeptList, cobEmployee, mTDateRange.DStart, mTDateRange.DEnd, cobEmployee.ListCount) Then GoTo ExitSub
sEmpList = gclsCommon.CBNGetFirstData(cobEmployee.Text)
If sEmpList = VALUE_ALL_STR Then
sEmpList = gclsCommon.CBNGetComboList(cobEmployee)
End If
If piMode = RPT_HOLIDAY Then
msCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList, "W6640", dtpRange(0), dtpRange(1))
ElseIf piMode = RPT_SWITCH Then
msCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList, "W0031", dtpRange(0), dtpRange(1) + 1)
ElseIf piMode = RPT_DAY1 Or piMode = RPT_ATTEND Or piMode = RPT_SPECCARD Then
msCondition = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList, "E6600", dtpRange(0), dtpRange(1))
End If
If msCondition <> "" Then msCondition = " WHERE " & msCondition
Set madoReportRS = New ADODB.Recordset
If Index = 3 Then '计算
LoCalculate
If mbError Then MsgBox "计算过程发生错误,请重新计算一次", vbCritical
GoTo ExitSub
Else
sSQL = LoGetSQL(IIf(Index = 0, False, True))
gDBRecordConn.CommandTimeout = 500
madoReportRS.Open sSQL, gDBRecordConn, adOpenStatic, adLockReadOnly
gDBRecordConn.CommandTimeout = 30
End If
Select Case piMode
Case RPT_ATTEND
If madoReportRS.RecordCount = 0 Then
MsgBox "无有效数据,请先做考勤计算!", vbCritical
GoTo ExitSub
End If
msDesc = "员工日出勤报表"
Case RPT_SPECCARD
If madoReportRS.RecordCount = 0 Then
MsgBox "无有效的特卡数据,请先做考勤修正!", vbCritical
GoTo ExitSub
End If
msDesc = "员工日特卡出勤报表"
Case RPT_HOLIDAY
If madoReportRS.RecordCount = 0 Then
MsgBox "无有效请假数据", vbCritical
GoTo ExitSub
End If
Case RPT_SWITCH
If madoReportRS.RecordCount = 0 Then
MsgBox "无有效换班数据", vbCritical
GoTo ExitSub
End If
Case RPT_DAY1
If madoReportRS.RecordCount = 0 Then
MsgBox "无有效日考勤报表数据", vbCritical
GoTo ExitSub
End If
End Select
If Index = 0 Or Index = 2 Then '0-导出EXCEL;2-导出其他格式
If Index = 0 Then '导出EXCEL
sFileName = gclsInclude.MyGetFileName(False, "Excel (*.xls)|*.xls", "xls", gTAppLicInfo.FilePathApp & "Report\" & msDesc, Me.hwnd)
If sFileName = "" Then GoTo ExitSub
End If
If cobOutput.ListIndex = 0 Then '按报表导出
If piMode = RPT_ATTEND Then
sFields = gclsCommon.CBNGetRptFields(rptAttendDetailGroup, "SectionDetail")
Set rptAttendDetailGroup = Nothing
ElseIf piMode = RPT_SPECCARD Then
sFields = gclsCommon.CBNGetRptFields(rptSpecCardGroup, "SectionDetail")
Set rptSpecCardGroup = Nothing
ElseIf piMode = RPT_HOLIDAY Then
sFields = gclsCommon.CBNGetRptFields(rptHolidayRpt, "SectionDetail")
Set rptHolidayRpt = Nothing
ElseIf piMode = RPT_SWITCH Then
sFields = gclsCommon.CBNGetRptFields(rptClassSwitch, "SectionDetail")
Set rptClassSwitch = Nothing
ElseIf piMode = RPT_DAY1 Then
sFields = gclsCommon.CBNGetRptFields(rptMonth1, "SectionDetail")
Set rptMonth1 = Nothing
End If
ElseIf cobOutput.ListIndex = 1 Then
sFields = ""
ElseIf cobOutput.ListIndex = 2 Then
sFields = gclsInclude.MyGetINIData(gTAppLicInfo.FileINI, "Report", "Month1", "")
End If
If Index = 0 Then '导出EXCEL
gclsCommon.CBNOutputDBase madoReportRS, sFileName, SPLIT_SYMBOL, "", msDesc, sFields
MsgBox "文件被保存为" & sFileName
ElseIf Index = 2 Then '导出其他格式
sSQL = gclsInclude.MyReplace(sSQL, "SELECT * FROM", "SELECT " & sFields & " FROM")
i = InStr(sSQL, "APPEND ({")
If i > 0 Then
i = InStr(i, sSQL, "{")
sSQL = Mid(sSQL, i + 1)
i = InStr(sSQL, "}")
sSQL = Left(sSQL, i - 1)
End If
sSQL = gclsInclude.MyReplace(sSQL, "SELECT * FROM", "SELECT " & sFields & " FROM")
sSQL = Replace(sSQL, "FROMFROM", "FROM")
If InStr(sSQL, "BETWEEN") > 0 Then
sFields = Mid(sSQL, InStr(sSQL, "BETWEEN"))
sFields = Replace(sFields, "'", "#")
sSQL = Left(sSQL, InStr(sSQL, "BETWEEN") - 1) & sFields
End If
If gclsDBFunc.dbExport(sSQL, gDBRecordConn, gTAppLicInfo.FilePathApp & "Report\" & msDesc) Then
MsgBox "数据成功导出!"
End If
End If
ElseIf Index = 1 Then
If piMode = RPT_ATTEND Then
iPaper = 1
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptAttendDetailGroup
Set rptAttendDetailGroup = Nothing
ElseIf piMode = RPT_SPECCARD Then
iPaper = 0
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptSpecCardGroup
Set rptSpecCardGroup = Nothing
ElseIf piMode = RPT_HOLIDAY Then
iPaper = 0
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptHolidayRpt
Set rptHolidayRpt = Nothing
ElseIf piMode = RPT_SWITCH Then
iPaper = 0
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptClassSwitch
Set rptClassSwitch = Nothing
ElseIf piMode = RPT_DAY1 Then
iPaper = 1
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptMonth1
Set rptMonth1 = Nothing
End If
Set rRpt.DataSource = madoReportRS
' For l = 1 To 10: DoEvents: Next l
' rRpt.Hide
For l = 1 To 10: DoEvents: Next l
If piMode = RPT_DAY1 Then
'对 rptMonth1 重排
lWidth = 360
With rRpt
lLeft = .Sections("Section1").Controls("lneCap0").Left
For l = 1 To 31
.Sections("Section1").Controls("lbl" & l).Width = lWidth - 20
.Sections("Section1").Controls("lbl" & l).Left = lLeft + 10
.Sections("SectionDetail").Controls("txt" & l).Width = lWidth - 20
.Sections("SectionDetail").Controls("txt" & l).Left = lLeft + 10
lLeft = lLeft + lWidth
.Sections("Section1").Controls("lneCap" & l).Left = lLeft
.Sections("SectionDetail").Controls("lneDet" & l).Left = lLeft
Next l
For l = 1 To 6
.Sections("Section1").Controls("lblRpt" & l).Width = 450
.Sections("Section1").Controls("lblRpt" & l).Left = lLeft + 10
.Sections("SectionDetail").Controls("txtRpt" & l).Width = 450
.Sections("SectionDetail").Controls("txtRpt" & l).Left = lLeft + 10
lLeft = lLeft + 470
.Sections("Section1").Controls("lneRpt" & l).Left = lLeft
.Sections("SectionDetail").Controls("lneTxtRpt" & l).Left = lLeft
Next l
.Sections("Section2").Controls("lneEnd").Left = lLeft
.Sections("Section1").Controls("Line0").Width = lLeft
.Sections("Section1").Controls("Line1").Width = lLeft
.Sections("SectionDetail").Controls("Line2").Width = lLeft
.Sections("Section2").Controls("Line3").Width = lLeft
lDeltaWidth = 0
For i = 1 To 7
If i < 7 Then
.Sections("Section2").Controls("lneLblFunc" & i).Left = .Sections("Section1").Controls("lneCap" & 3 + (i - 1) * 5).Left
.Sections("Section2").Controls("lneFunc" & i).Left = .Sections("Section1").Controls("lneCap" & i * 5).Left
.Sections("Section2").Controls("lblFunc" & i).Left = .Sections("Section1").Controls("lneCap" & (i - 1) * 5).Left + 10
.Sections("Section2").Controls("func" & i).Left = .Sections("Section1").Controls("lneCap" & 3 + (i - 1) * 5).Left + 30
Else
If lDeltaWidth = 0 Then
lDeltaWidth = .Sections("Section1").Controls("lneCap5").Left - .Sections("Section1").Controls("lneCap0").Left
End If
.Sections("Section2").Controls("lneLblFunc" & i).Left = .Sections("Section2").Controls("lneLblFunc" & i - 1).Left + lDeltaWidth
bTemp = False
For l = 1 To 6
If Abs(.Sections("Section1").Controls("lneRpt" & l).Left - .Sections("Section2").Controls("lneFunc" & i - 1).Left - lDeltaWidth) < 100 Then
bTemp = True
.Sections("Section2").Controls("lneFunc" & i).Left = .Sections("Section1").Controls("lneRpt" & l).Left
Exit For
End If
Next l
If Not bTemp Then
.Sections("Section2").Controls("lneFunc" & i).Left = .Sections("Section2").Controls("lneFunc" & i - 1).Left + lDeltaWidth
End If
.Sections("Section2").Controls("lblFunc" & i).Left = .Sections("Section2").Controls("lblFunc" & i - 1).Left + lDeltaWidth
.Sections("Section2").Controls("func" & i).Left = .Sections("Section2").Controls("func" & i - 1).Left + lDeltaWidth
End If
Next i
.Sections("ReportHeader").Controls("lblStart").Caption = dtpRange(0)
.Sections("ReportHeader").Controls("lblEnd").Caption = dtpRange(1)
End With
For l = 1 To 10: DoEvents: Next l
ElseIf piMode = RPT_ATTEND Or piMode = RPT_SPECCARD Then
' If piMode = RPT_ATTEND Then
' If gTAppLicInfo.UserEnName = "xx" Then '对于客户B，不要求显示出勤天数
' rRpt.Sections("Section2").Controls("Function13").Visible = False
' rRpt.Sections("Section2").Controls("Label33").Visible = False
' End If
' End If
With rRpt
If gTAttendCtl.AttRptGroup Then
.Sections("Section2").ForcePageBreak = rptPageBreakAfter
Else
.Sections("PageFooter").Controls("Label34").Visible = False
.Sections("PageFooter").Controls("Line66").Visible = False
End If
End With
End If
With rRpt
If iPaper = 1 Then
.ReportWidth = 16000
End If
.Show IIf(gTAppLicInfo.CtrlRunSingle, vbModal, vbModeless)
End With
If gTAppLicInfo.CtrlRunSingle Then Set rRpt = Nothing
End If
Exit Sub
ExitSub:
Screen.MousePointer = vbDefault
ProgressBar1.Visible = False
StatusBar1.Panels(1).Text = ""
Exit Sub
ErrorHandler:
If Err = 484 Then
MsgBox Err.Description
ElseIf Err = 3265 Then
MsgBox Err.Description & "请升级数据库系统!"
Resume Next
Else
MsgBox Err.Description
Resume Next
End If
End Sub
Private Function LoGetSQL(Optional ByVal fbGroup As Boolean = False) As String
Dim sSQLStr As String
Dim i As Integer
Dim j As Integer
Dim sFilter As String
Dim sSort As String
Dim sTblName As String
Dim sEmpList As String
Dim sSplit
Dim bDisabled As Boolean
Select Case piMode
Case RPT_ATTEND
sTblName = "QT6621A001_002"
Case RPT_SPECCARD
sTblName = "QT6621A001_003"
Case RPT_HOLIDAY
sTblName = "QT6645A001_002"
Case RPT_SWITCH
sTblName = "QT6623A001_002"
Case RPT_DAY1
sTblName = "QA066A001_001"
End Select
mTFieldRec = gclsCommon.CBNGetFieldRec(sTblName)
For i = 1 To UBound(mTFieldRec)
If mTFieldRec(i).FieldName <> "" Then
sSQLStr = sSQLStr & mTFieldRec(i).FieldName & ","
End If
Next i
sSQLStr = Left(sSQLStr, Len(sSQLStr) - 1)
sEmpList = gclsCommon.CBNGetFirstData(cobEmployee.Text)
If sEmpList = VALUE_ALL_STR Then
sEmpList = gclsCommon.CBNGetComboList(cobEmployee)
End If
If piMode <> RPT_DAY1 Then
LoGetSQL = "SELECT " & sSQLStr & " FROM " & sTblName & msCondition
Else
' If fbGroup And Not gTAppLicInfo.SoftNetwork Then
If fbGroup Then
LoGetSQL = "SHAPE {SELECT DISTINCT E0122,B0105 FROM " & sTblName & " WHERE " & _
gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList) & _
" ORDER BY E0122} AS ParentCMD APPEND " & _
"({SELECT * FROM " & sTblName & " WHERE " & _
gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList) & " ORDER BY A0189} AS ChildCmd " & _
"RELATE E0122 TO E0122) AS ChildCMD"
Else
LoGetSQL = "SELECT " & sSQLStr & " FROM " & sTblName & " WHERE " & _
gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList)
LoGetSQL = LoGetSQL & " ORDER BY E0122,A0189"
End If
End If
If Right(LoGetSQL, 4) = "AND " Then LoGetSQL = Left(LoGetSQL, Len(LoGetSQL) - 5)
If piMode = RPT_ATTEND Or piMode = RPT_SPECCARD Then
LoGetSQL = LoGetSQL & " ORDER BY E0122,A0189,E6600"
' If fbGroup And Not gTAppLicInfo.SoftNetwork Then
If fbGroup Then
' sFilter = gclsCommon.CBNGetCondition(BNListTree1.UnitList, BNListTree1.DeptList, sEmpList)
LoGetSQL = "SHAPE {SELECT DISTINCT A0189 FROM " & sTblName & msCondition & _
" ORDER BY A0189} AS ParentCMD APPEND ({" & LoGetSQL & "} AS ChildCmd RELATE A0189 TO A0189) AS ChildCMD"
End If
ElseIf piMode = RPT_HOLIDAY Then
LoGetSQL = LoGetSQL & " ORDER BY E0122,A0189,W6640"
ElseIf piMode = RPT_SWITCH Then
LoGetSQL = LoGetSQL & " ORDER BY E0122,A0189,W0031"
End If
End Function
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 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
Else
If bCancle Then
StatusBar1.Panels(1).Text = "未输入有效的员工"
Else
MsgBox "未输入有效的员工", vbCritical
End If
End If
End Sub
#ElseIf APPLICATION_TYPE = 2 Then '门禁
Private Sub cmdOutput_Click(Index As Integer)
Dim sSQL As String
Dim sEmpList As String
Dim l As Long
Dim adoTempRS As ADODB.Recordset
Dim TFieldStruct() As FieldStruct
Dim bTemp As Boolean
Dim DToday As Date
sEmpList = gclsCommon.CBNGetFirstData(cobEmployee.Text)
If sEmpList = VALUE_ALL_STR Then
sEmpList = gclsCommon.CBNGetComboList(cobEmployee)
End If
If piMode = RPT_DAY1 Then
sSQL = gclsCommon.CBNGetCondition("", "", sEmpList, "W3007", mTDateRange.DStart, mTDateRange.DEnd + 1)
End If
Set adoTempRS = New ADODB.Recordset
sSQL = "SELECT * FROM QT3005A001_001 WHERE" & sSQL
adoTempRS.Open gclsCommon.CBNCSql(sSQL), gDBRecordConn, adOpenStatic, adLockReadOnly
If adoTempRS.RecordCount = 0 Then
MsgBox "该范围内无记录!", vbCritical
Exit Sub
End If
TFieldStruct = gclsDBFunc.dbGetTblStruct("QT3005A001_001", gDBRecordConn)
If Not gclsCommon.CBNIsEmpty(VarPtrArray(TFieldStruct)) Then
ReDim Preserve TFieldStruct(UBound(TFieldStruct) + 1)
l = UBound(TFieldStruct)
TFieldStruct(l) = TFieldStruct(l - 1)
With TFieldStruct(l)
.sFldName = "W0111"
.lSize = 1
.lTypeADO = eadVarChar
End With
End If
Set madoReportRS = gclsDBFunc.dbCreateVRecord(TFieldStruct)
With madoReportRS
bTemp = False
For l = 0 To mTDateRange.DEnd - mTDateRange.DStart
DToday = mTDateRange.DStart + l
Next l
End With
End Sub
#ElseIf APPLICATION_TYPE = 3 Then '巡更
Private Sub cmdOutput_Click(Index As Integer)
Dim sSQL As String
Dim sEmpList As String
Dim l As Long
Dim TFieldStruct() As FieldStruct
Dim bTemp As Boolean
Dim DToday As Date
Dim iPaper As Integer
Dim rRpt
sEmpList = gclsCommon.CBNGetFirstData(cobEmployee.Text)
If sEmpList = VALUE_ALL_STR Then
sEmpList = gclsCommon.CBNGetComboList(cobEmployee)
End If
If piMode = RPT_DAY1 Then
sSQL = gclsCommon.CBNGetCondition("", "", sEmpList, "W3007", mTDateRange.DStart, mTDateRange.DEnd + 1)
End If
Set madoReportRS = New ADODB.Recordset
If sSQL <> "" Then
sSQL = "WHERE" & sSQL
If Option1(1).Value Then
sSQL = sSQL & " AND (W0111 ='1')"
ElseIf Option1(1).Value Then
End If
End If
sSQL = "SELECT DISTINCT * FROM QT3005A001_001 " & sSQL & " ORDER BY A0189,W3007,W3006"
gDBRecordConn.CommandTimeout = 500
madoReportRS.Open gclsCommon.CBNCSql(sSQL), gDBRecordConn, adOpenStatic, adLockReadOnly
gDBRecordConn.CommandTimeout = 30
If madoReportRS.RecordCount = 0 Then
MsgBox "该范围内无记录!", vbCritical
Exit Sub
End If
If piMode = RPT_DAY1 Then
iPaper = 0
If Not SetPrintPaple(iPaper) Then GoTo ExitSub
Set rRpt = New rptPatrolReport
Set rptPatrolReport = Nothing
End If
Set rRpt.DataSource = madoReportRS
' For l = 1 To 10: DoEvents: Next l
' rRpt.Hide
For l = 1 To 10: DoEvents: Next l
If iPaper = 1 Then
rRpt.ReportWidth = 16000
End If
rRpt.Show IIf(gTAppLicInfo.CtrlRunSingle, vbModal, vbModeless)
For l = 1 To 10: DoEvents: Next l
Exit Sub
ExitSub:
Screen.MousePointer = vbDefault
ProgressBar1.Visible = False
StatusBar1.Panels(1).Text = ""
End Sub
Private Sub LoListEmployee()
Dim adoTempRS As ADODB.Recordset
cobEmployee.Clear
cobEmployee.AddItem VALUE_ALL_STR
cobEmployee.ItemData(cobEmployee.NewIndex) = 0
StatusBar1.Panels(1).Text = "正在加载员工数据"
DoEvents
Set adoTempRS = New ADODB.Recordset
With adoTempRS
.Open "SELECT * FROM QT3003A001_001 WHERE A0101 IS NOT NULL", gDBRecordConn, adOpenStatic, adLockReadOnly
Do While Not .EOF
If .RecordCount > 0 Then
cobEmployee.AddItem !A0189 & SPLIT_SYMBOL & !A0101
.MoveNext
End If
Loop
.Close
End With
Set adoTempRS = Nothing
If cobEmployee.ListCount > 0 Then cobEmployee.ListIndex = 0
StatusBar1.Panels(1).Text = "加载员工数据完毕"
End Sub
#End If
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
If mTDateRange.DStart > mTDateRange.DEnd Then
dtpRange(1 - Index).Value = 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
LoSetButtonTag
SetIcon Me
BNListTree1.RefuseDeptList = gTOperRight.RefuseDeptRight
gclsCommon.CBNFillBNListTree BNListTree1
mbError = False
cobOutput.AddItem "按报表导出"
cobOutput.AddItem "全部导出"
If piMode = RPT_DAY1 Then
cobOutput.AddItem "自定义导出"
End If
gclsInclude.MyShowPbrInSbr ProgressBar1, StatusBar1.hwnd, 1
cobOutput.ListIndex = 0
LoadPickStruct BNListTree1, mTDateRange, cobEmployee
dtpRange(0).Value = mTDateRange.DStart
dtpRange(1).Value = mTDateRange.DEnd
#If APPLICATION_TYPE = 1 Then '考勤
Select Case piMode
Case RPT_ATTEND
msDesc = "员工日出勤报表"
cmdOutput(3).Visible = False
Case RPT_SPECCARD
msDesc = "员工日特卡出勤报表"
cmdOutput(3).Visible = False
Case RPT_HOLIDAY
msDesc = "员工日请假报表"
Case RPT_SWITCH
msDesc = "员工换班报表"
cmdOutput(3).Visible = False
Case RPT_DAY1
LoSetSystemRule
msDesc = "员工出勤月报表" & IIf(piMode = RPT_DAY1, "一", "二")
End Select
#ElseIf APPLICATION_TYPE = 3 Then '巡更
Frame2.Visible = True
LoListEmployee
Select Case piMode
Case RPT_DAY1
msDesc = "巡更员日巡更报表"
cmdOutput(3).Visible = False
BNListTree1.Visible = False
cmdFind(0).Visible = False
cobOutput.Visible = False
cmdOutput(0).Visible = False
cmdOutput(2).Visible = False
Label1.Visible = False
End Select
#End If
Me.Caption = msDesc
If gTAppLicInfo.SysLockCal And Not gTAppLicInfo.SysLoginSA Then
StatusBar1.Panels(1).Text = "功能暂时锁定!"
cmdOutput(3).Visible = False
End If
Exit Sub
ErrLabel:
MsgBox "发生错误,错误号=" & Err & ",错误原因=" & Err.Description & ",错误模块=FormLoad"
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Dim i As Integer
SavePickStruct BNListTree1, mTDateRange, cobEmployee
Set madoReportRS = Nothing
Set madoRsltRS = Nothing
End Sub
Private Sub LoSetSystemRule()
Dim i As Integer
Dim adoTempRS As ADODB.Recordset
Set adoTempRS = New ADODB.Recordset
adoTempRS.Open "SELECT * FROM T0118S001", gDBRecordConn, adOpenStatic, adLockReadOnly
With adoTempRS
If .RecordCount > 0 Then
ReDim mTHoliSystem(1 To .RecordCount)
For i = 1 To .RecordCount
mTHoliSystem(i).W6670 = (gclsInclude.MyNz(!W6670, 0) = 1)
mTHoliSystem(i).W6671 = !W6671
mTHoliSystem(i).W6673 = (!W6673 = 1)
mTHoliSystem(i).W6674 = !W6674
mTHoliSystem(i).W6675 = !W6675
mTHoliSystem(i).W6676 = !W6676
.MoveNext
Next i
End If
.Close
End With
End Sub
Private Sub LoSetButtonTag()
cmdExit.Tag = "IMG029"
cmdFind(0).Tag = "IMG031"
cmdOutput(0).Tag = "IMG027"
cmdOutput(1).Tag = "IMG031"
cmdOutput(2).Tag = "IMG065"
cmdOutput(3).Tag = "IMG028"
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub