📄 +
字号:
Picture = "计算工资.frx":386FC
Key = "prev"
EndProperty
BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":38A96
Key = "next"
EndProperty
BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":38E30
Key = "last"
EndProperty
BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":391CA
Key = "Item"
EndProperty
BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":39564
Key = "define"
EndProperty
BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":398FE
Key = "exec"
EndProperty
BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":39C98
Key = "xz"
EndProperty
BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3A032
Key = "sc"
EndProperty
BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3A3CC
Key = "sx"
EndProperty
BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3A766
Key = "cx"
EndProperty
BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3AB00
Key = "zd"
EndProperty
BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3AE9A
Key = "dz"
EndProperty
BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3B234
Key = "ph"
EndProperty
BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3B5CE
Key = "fz"
EndProperty
BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3B968
Key = "dw"
EndProperty
BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3BD02
Key = "Compute"
EndProperty
BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3C09C
Key = "Refresh"
EndProperty
BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "计算工资.frx":3C436
Key = "Locate"
EndProperty
EndProperty
End
Begin VB.Label Lab_OperStatus
BackColor = &H000080FF&
Caption = "1"
Height = 345
Left = 10500
TabIndex = 5
Top = 1440
Visible = 0 'False
Width = 345
End
End
Attribute VB_Name = "Salary_Frm_Compute"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************************************************
'* 模 块 名 称 计算工资
'* 功 能 描 述 :
'* 程序员姓名 :苗鹏
'* 最后修改人 :苗鹏
'* 最后修改时间:2002/01/01
'*
'***************************************************************************************
'以下为自定义变量
Dim sFields() As New CFieldValue
Public sSqlWhere As String
Public sSortID As String
Public sSqlWhereTax As String
Dim iYear As Integer
Dim iPeriod As Integer
Dim bRefreshData As Boolean
'其它固定使用变量
Dim Tsxx As String '系统信息提示(Fixed)
Dim ReportTitle As String '报表主标题(Fixed)
'以下为固定使用变量(网格)
Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Pmbcsjhs As Long '屏幕网格保持数据行数(大于等于1)
Dim Fzxwghs As Integer '辅助项网格行数(包括合计行)
Dim Sfxshjwg As Boolean '是否显示合计网格
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Sfblbzkd As Boolean '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh As Long '当前录入数据网格行
Dim Dqlrwgl As Long '当前录入数据网格列
Dim Dqlkwgh As Long '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl As Long '刚刚离开网格列
Dim Dqtoprow As Long '当前录入状态时最上端可视行
Dim Dqleftcol As Long '当前录入状态时最左端可视列
Dim Zdlrqnr As String '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock As Boolean '文本框改变值锁
Dim Changelock As Boolean '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock As Boolean '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock As Boolean '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock As Boolean '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock As Boolean '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts As Boolean '删除记录行是否提示
Dim Szzls As Integer '网格信息数组最大下标值(网格列数-1)
Private Sub Form_KeyPress(KeyAscii As Integer) '限制录入字符"'"
Select Case KeyAscii
Case 39 '屏蔽字符"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load() '窗 体 装 入
On Error GoTo ErrCtrl
Dim s As String
Dim rs As New ADODB.Recordset
Dim nod As ComboItem
'初始化各种锁值(Fixed)
Changelock = False '网格行列改变控制锁
Gdtlock = False '滚动条滚动控制
Yxxpdlock = True '字段有效性判断锁
Hyxxpdlock = True '行有效性判断锁
Wbkbhlock = False '文本框内容改变锁
'报表主标题及报表编码(Fixed)
ReportTitle = "计算工资"
XtReportCode = "PM_ComputeSalary"
Load Dyymctbl
'调 入 网 格(Fixed)
GridCode = "Pm_ComputeSalary" '网格属性编码
Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Pmbcsjhs = GridInf(3)
Fzxwghs = GridInf(4)
Sfblbzkd = GridInf(5)
Shsfts = GridInf(6)
Sfxshjwg = GridInf(7)
Szzls = WglrGrid.Cols - 1
'设置标题栏宽度、网格宽度高度(Fixed)
Pic_Title.Move 50, Pic_Title.Top, Me.Width - 150, Pic_Title.Height
WglrGrid.Move 50, Pic_Title.Top + Pic_Title.Height, Me.Width - 150
WglrGrid.Height = Me.Height - WglrGrid.Top - 380
'填充工资类别
s = "select b.SortID,b.SortName FROM PM_OpeSort a inner join PM_Sort b ON a.SortID=b.SortID WHERE a.Czybm='" & Xtczybm & "'"
Set rs = Cw_DataEnvi.DataConnect.Execute(s)
With rs
Do While Not .EOF()
Set nod = Me.ImgCmb_Sort.ComboItems.Add(, "@" & Trim(!SortId), Trim(!SortName))
nod.Tag = !SortId
.MoveNext
Loop
.Close
End With
'设置状态为修改状态
Lab_OperStatus = "2"
'取得会计期间
s = "select Top 1 KjYear,Period FROM GY_Kjrlb WHERE PMjzbz= 0 ORDER BY KjYear,Period "
Set rs = Cw_DataEnvi.DataConnect.Execute(s)
With rs
If Not .EOF() Then
TextChangeLock = True
iYear = rs!KjYear
iPeriod = rs!Period
Else
MsgBox "当前会计日期未知", vbOKOnly + vbCritical
Exit Sub
End If
.Close
End With
Set rs = Nothing
Exit Sub
ErrCtrl:
If rs.State = 1 Then
rs.Close
End If
Set rs = notjing
Set nod = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
If Not Fun_Drfrmyxxpd Then
Cancel = True
Exit Sub
End If
'卸载打印页面窗体
Unload Dyymctbl
End Sub
Public Function ShowRecord(sSortID As String) '查询数据填充网格
On Error GoTo ErrCtrl
'判断刷新是否完成
Me.MousePointer = 11
If bRefreshData = True Then
Me.MousePointer = 0
Exit Function
End If
'设置默认查询条件
Dim sWhere As String
If Trim(sSqlWhere) = "" Then
sSqlWhere = "WHERE PM_PayRoll.DeptCode in (Select DeptCode FROM PM_OpeDept WHERE Czybm='" & Xtczybm & "') " & Chr(10) _
& " AND PM_PayRoll.SortID in (Select SortID FROM PM_OpeSort WHERE Czybm ='" & Xtczybm & "') " & Chr(10) _
& " AND PM_PayRoll.KjYear=" & iYear & " AND PM_PayRoll.Period=" & iPeriod
End If
sWhere = sSqlWhere & " AND PM_PayRoll.SortID='" & sSortID & "' " & Chr(10) _
& " AND PM_PayRoll.KjYear=" & iYear & " AND PM_PayRoll.Period=" & iPeriod
'定义变量
Dim s As String
Dim rs As New ADODB.Recordset
Dim sSqlExec As String
Dim sSqlSelect As String
Dim sSqlFrom As String
Dim sSqlOrder As String
Dim i As Long
Dim j As Long
Dim iFixedCols As Integer
Dim iBeginCol As Integer
'初始化各种变量
iBeginCol = GridInf(1) '数据开始行数
'From子句
sSqlFrom = " FROM PM_PayRoll Inner Join Rs_BasicInfo ON Rs_BasicInfo.EmpID=PM_PayRoll.EmpID " & Chr(10) _
& " Left Outer Join Rs_ExtendInfo ON PM_PayRoll.EmpID=Rs_ExtendInfo.EmpID " & Chr(10) _
& " Left Outer Join PM_AttendRecord ON PM_PayRoll.EmpID=PM_AttendRecord.EmpID AND PM_PayRoll.KjYear=PM_AttendRecord.KjYear AND PM_PayRoll.Period=PM_AttendRecord.Period " & Chr(10)
'Order子句
sSqlOrder = " ORDER BY PM_PayRoll.DeptCode,Rs_BasicInfo.EmpNo"
ReDim sFields(2) '字段属性
sFields(0).FieldName = "PM_PayRoll#DeptCode"
sFields(0).FieldValueName = "PM_PayRoll#DeptCode#N"
sFields(0).FieldNameC = "部门"
sFields(0).FieldLengthInt = 0
sFields(0).FieldLengthFra = 0
sFields(1).FieldName = "PM_PayRoll#EmpNo"
sFields(1).FieldValueName = "PM_PayRoll#EmpNo"
sFields(1).FieldNameC = "工号"
sFields(1).FieldLengthInt = 0
sFields(1).FieldLengthFra = 0
sFields(2).FieldName = "PM_PayRoll#EmpName"
sFields(2).FieldValueName = "PM_PayRoll#EmpName"
sFields(2).FieldNameC = "姓名"
sFields(2).FieldLengthInt = 0
sFields(2).FieldLengthFra = 0
'select子句
sSqlSelect = "select Pm_PayRoll.EmpID AS Pm_PayRoll#EmpID " & Chr(10) _
& " ,PM_PayRoll#DeptCode#N=(select DeptName FROM GY_Department a WHERE a.DeptCode=PM_PayRoll.DeptCode) " & Chr(10) _
& " ,PM_PayRoll.EmpNo AS PM_PayRoll#EmpNo " & Chr(10) _
& " ,PM_PayRoll.EmpName AS PM_PayRoll#EmpName " & Chr(10)
s = "select Top 1 KjYear,Period FROM GY_Kjrlb WHERE PMjzbz= 0 ORDER BY KjYear,Period " '会计期间
Set rs = Cw_DataEnvi.DataConnect.Execute(s)
With rs
If Not .EOF() Then
iPeriod = !Period
iYear = !KjYear
Else
MsgBox "当前会计日期未知", vbOKOnly + vbCritical
Exit Function
End If
.Close
End With
'生成查询语句
'工资项
s = "select b.FieldName AS FieldName ,b.ChName AS FieldNameC,b.FieldLength AS FieldLength ,b.FieldDotL AS FieldDotL " & Chr(10) _
& " FROM PM_SortItem a inner join Rs_Items b ON a.ItemID=b.ItemID " & Chr(10) _
& " WHERE a.HaltFlag=0 AND SortID ='" & sSortID & "'" & Chr(10) _
& " order by a.DisplayOrder "
Set rs = Cw_DataEnvi.DataConnect.Execute(s)
With rs
Do While Not .EOF()
If Trim(sFields(0).FieldName) <> "" Then
ReDim Preserve sFields(UBound(sFields) + 1)
End If
sFields(UBound(sFields)).FieldName = Trim("PM_PayRoll#" & Trim(!FieldName))
sFields(UBound(sFields)).FieldValueName = Trim("PM_PayRoll#" & Trim(!FieldName))
sFields(UBound(sFields)).FieldNameC = Trim(!FieldNameC)
sFields(UBound(sFields)).FieldLengthInt = !FieldLength - !FieldDotL
sFields(UBound(sFields)).FieldLengthFra = !FieldDotL
sSqlSelect = sSqlSelect & ",PM_PayRoll." & Trim(!FieldName) & " AS " & sFields(UBound(sFields)).FieldValueName & Chr(10)
.MoveNext
Loop
.Close
End With
With Me.WglrGrid
'初始化网格
.Redraw = False
.Cols = UBound(sFields) + 2
.FixedCols = iBeginCol + 3
s = "#,##0"
For i = .FixedCols To .Cols - 1
.ColAlignment(i) = flexAlignRightCenter
.ColFormat(i) = s & IIf(sFields(i - 1).FieldLengthFra = 0, "", "." & String(sFields(i - 1).FieldLengthFra, "0"))
Next i
For i = 1 To .Cols - 1
.TextMatrix(0, i) = sFields(i - 1).FieldNameC
.FixedAlignment(i) = flexAlignCenterCenter
Next i
'填充数据
sSqlSelect = Trim(sSqlSelect)
sSqlExec = sSqlSelect & sSqlFrom & sWhere & sSqlOrder
Set rs = Cw_DataEnvi.DataConnect.Execute(sSqlExec)
.Rows = .FixedRows + rs.RecordCount
'初始化进度条
Me.PB_Proc.Visible = True
Me.PB_Proc.Min = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -