English
资源名称：ERPSYS.zip [点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：45k
源码类别：
企业管理
开发平台：
Visual Basic
- VERSION 5.00
- Object = "{D76D7128-4A96-11D3-BD95-D296DC2DD072}#1.0#0"; "VSOCX7.OCX"
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
- Begin VB.Form Rep_DIYSalary_Frm
- BackColor = &H8000000A&
- Caption = "自定义报表"
- ClientHeight = 8595
- ClientLeft = 315
- ClientTop = 390
- ClientWidth = 11820
- HelpContextID = 5001
- Icon = "报表_自定义报表.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form1"
- MDIChild = -1 'True
- ScaleHeight = 8595
- ScaleWidth = 11820
- WindowState = 2 'Maximized
- Begin MSComctlLib.ProgressBar PB_Proc
- Height = 330
- Left = 3795
- TabIndex = 5
- Top = 3735
- Visible = 0 'False
- Width = 4440
- _ExtentX = 7832
- _ExtentY = 582
- _Version = 393216
- Appearance = 1
- Scrolling = 1
- End
- Begin VB.PictureBox Pic_Title
- BackColor = &H00FFFFFF&
- Height = 1065
- Left = -75
- Picture = "报表_自定义报表.frx":1042
- ScaleHeight = 1005
- ScaleWidth = 11790
- TabIndex = 3
- Top = 585
- Width = 11850
- Begin VB.Label Lab_Period
- AutoSize = -1 'True
- BackStyle = 0 'Transparent
- Caption = "会计期间:"
- Height = 180
- Left = 1095
- TabIndex = 6
- Top = 735
- Width = 810
- End
- Begin VB.Label Lab_Title
- AutoSize = -1 'True
- BackColor = &H80000018&
- BackStyle = 0 'Transparent
- Caption = "自定义报表"
- BeginProperty Font
- Name = "宋体"
- Size = 12
- Charset = 134
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H00000000&
- Height = 240
- Left = 510
- TabIndex = 4
- Top = 240
- Width = 1275
- End
- End
- Begin MSComctlLib.Toolbar GsToolbar
- Height = 540
- Left = 10095
- TabIndex = 1
- Top = 30
- Width = 1725
- _ExtentX = 3043
- _ExtentY = 953
- ButtonWidth = 1455
- ButtonHeight = 953
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 3
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "保存格式"
- Key = "bcgs"
- ImageKey = "bcgs"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Object.Visible = 0 'False
- Caption = "默认列宽"
- Key = "hfmrgs"
- ImageKey = "mrlk"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "显示项目"
- Key = "szxsxm"
- ImageKey = "xsxm"
- EndProperty
- EndProperty
- End
- Begin VB.Timer Timer1
- Enabled = 0 'False
- Interval = 1
- Left = 7620
- Top = 90
- End
- Begin VSFlex8Ctl.VSFlexGrid CxbbGrid
- Height = 7350
- Left = 60
- TabIndex = 0
- Top = 1710
- Width = 11775
- _ExtentX = 20770
- _ExtentY = 12965
- Appearance = 1
- BorderStyle = 1
- Enabled = -1 'True
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- MousePointer = 0
- BackColor = 16777215
- ForeColor = -2147483640
- BackColorFixed = 13826538
- ForeColorFixed = -2147483630
- BackColorSel = -2147483635
- ForeColorSel = -2147483634
- BackColorBkg = -2147483636
- BackColorAlternate= 16777215
- GridColor = -2147483633
- GridColorFixed = -2147483632
- TreeColor = -2147483632
- FloodColor = 192
- SheetBorder = -2147483642
- FocusRect = 1
- HighLight = 1
- AllowSelection = -1 'True
- AllowBigSelection= -1 'True
- AllowUserResizing= 0
- SelectionMode = 0
- GridLines = 1
- GridLinesFixed = 2
- GridLineWidth = 1
- Rows = 50
- Cols = 10
- FixedRows = 1
- FixedCols = 1
- RowHeightMin = 0
- RowHeightMax = 0
- ColWidthMin = 0
- ColWidthMax = 0
- ExtendLastCol = 0 'False
- FormatString = ""
- ScrollTrack = 0 'False
- ScrollBars = 3
- ScrollTips = 0 'False
- MergeCells = 0
- MergeCompare = 0
- AutoResize = -1 'True
- AutoSizeMode = 0
- AutoSearch = 0
- MultiTotals = -1 'True
- SubtotalPosition= 1
- OutlineBar = 0
- OutlineCol = 0
- Ellipsis = 0
- ExplorerBar = 0
- PicturesOver = 0 'False
- FillStyle = 0
- RightToLeft = 0 'False
- PictureType = 0
- TabBehavior = 0
- OwnerDraw = 0
- Editable = 0 'False
- ShowComboButton = -1 'True
- WordWrap = 0 'False
- TextStyle = 0
- TextStyleFixed = 0
- OleDragMode = 0
- OleDropMode = 0
- DataMode = 0
- VirtualData = -1 'True
- End
- Begin MSComctlLib.Toolbar SzToolbar
- Align = 1 'Align Top
- Height = 570
- Left = 0
- TabIndex = 2
- Top = 0
- Width = 11820
- _ExtentX = 20849
- _ExtentY = 1005
- ButtonWidth = 820
- ButtonHeight = 953
- AllowCustomize = 0 'False
- Appearance = 1
- Style = 1
- ImageList = "ImageList1"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 13
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "设置"
- Key = "ymsz"
- Object.ToolTipText = "设置打印参数"
- ImageKey = "sz"
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "打印"
- Key = "dy"
- Object.ToolTipText = "打印当前数据"
- ImageKey = "dy"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "预览"
- Key = "yl"
- Object.ToolTipText = "显示当前数据的打印模式"
- ImageKey = "yl"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "查询"
- Key = "cx"
- Object.ToolTipText = "以某种条件取得数据"
- ImageKey = "cx"
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "定位"
- Key = "Locate"
- Object.ToolTipText = "根据工号或姓名定位人员"
- ImageKey = "Locate"
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "刷新"
- Key = "Refresh"
- Object.ToolTipText = "以当前条件重新取得数据"
- ImageKey = "sx"
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "明细"
- Key = "Detail"
- Object.ToolTipText = "显示每个人员的信息"
- ImageKey = "Detail"
- Style = 1
- Value = 1
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "合计"
- Key = "Total"
- Object.ToolTipText = "显示合计信息"
- ImageKey = "Total"
- Style = 1
- Value = 1
- EndProperty
- BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "帮助"
- Key = "bz"
- Object.ToolTipText = "显示帮助信息"
- ImageKey = "bz"
- EndProperty
- BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Caption = "退出"
- Key = "fh"
- Object.ToolTipText = "退出本报表"
- ImageKey = "tc"
- EndProperty
- EndProperty
- BorderStyle = 1
- Begin MSComctlLib.ImageList ImageList1
- Left = 5280
- Top = 0
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 35
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":35106
- Key = "sz"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":354A0
- Key = "dy"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3583A
- Key = "yl"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":35BD4
- Key = "xg"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":35F6E
- Key = "zh"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":36308
- Key = "sh"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":366A2
- Key = "bc"
- EndProperty
- BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":36A3C
- Key = "fq"
- EndProperty
- BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":36DD6
- Key = "bz"
- EndProperty
- BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":37170
- Key = "tc"
- EndProperty
- BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3750A
- Key = "bcgs"
- EndProperty
- BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":378A4
- Key = "mrlk"
- EndProperty
- BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":37C3E
- Key = "xsxm"
- EndProperty
- BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":37FD8
- Key = "first"
- EndProperty
- BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":38372
- Key = "prev"
- EndProperty
- BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3870C
- Key = "next"
- EndProperty
- BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":38AA6
- Key = "last"
- EndProperty
- BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":38E40
- Key = "xx"
- EndProperty
- BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":391DA
- Key = "define"
- EndProperty
- BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":39574
- Key = "exec"
- EndProperty
- BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3990E
- Key = "xz"
- EndProperty
- BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":39CA8
- Key = "sc"
- EndProperty
- BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3A042
- Key = "sx"
- EndProperty
- BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3A3DC
- Key = "cx"
- EndProperty
- BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3A776
- Key = "zd"
- EndProperty
- BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3AB10
- Key = "dz"
- EndProperty
- BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3AEAA
- Key = "ph"
- EndProperty
- BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3B244
- Key = "fz"
- EndProperty
- BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3B5DE
- Key = "Locate"
- EndProperty
- BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3B978
- Key = "hf"
- EndProperty
- BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3BD12
- Key = "pz"
- EndProperty
- BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3C0AC
- Key = "check"
- EndProperty
- BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3C446
- Key = "Sum"
- EndProperty
- BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3C7E0
- Key = "Total"
- EndProperty
- BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "报表_自定义报表.frx":3CB7A
- Key = "Detail"
- EndProperty
- EndProperty
- End
- End
- End
- Attribute VB_Name = "Rep_DIYSalary_Frm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '**************************************************************************
- '* 模 块 名 称 :自定义报表
- '* 功 能 描 述 :
- '* 程序员姓名 :苗鹏
- '* 最后修改人 :苗鹏
- '* 最后修改时间:2002/01/01
- '* 备 注:
- '**************************************************************************
- Dim ReportTitle As String '报表主标题
- Public sSqlWhere As String
- Public sSqlFrom As String
- Public sPTableName As String
- Public sRCode As String
- Public sPmSort As String
- Public sGroupField As String
- Public iDeptBeginLevel As Integer
- Public iDeptEndLevel As Integer
- Dim sFieldValue() As New CFieldValue
- Dim iSumEndCol As Integer
- Dim iBeginCol As Integer
- Dim sData() As String
- '以下为固定使用变量
- Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
- Dim GridCode As String '显示网格网格代码
- Dim GridInf() As Variant '整个网格设置信息
- Dim Tsxx As String '系统提示信息
- Dim Qslz As Long '网格隐藏(非操作显示)列数
- Dim Sjhgd As Double '网格数据行高度
- Dim Sfxshjwg As Boolean '是否显示合计网格
- Dim GridBoolean() As Boolean '网格列信息(布尔型)
- Dim GridStr() As String '网格列信息(字符型)
- Dim GridInt() As Integer '网格列信息(整型)
- Dim Szzls As Integer '数组总列数(网格列数-1)
- Private Sub CxbbGrid_AfterMoveColumn(ByVal Col As Long, Position As Long)
- On Error Resume Next
- Dim i As Integer
- With Me.CxbbGrid
- ReDim sFieldValue(.Cols - 1)
- For i = 0 To .Cols - 1
- sFieldValue(i).FieldName = Trim(.TextMatrix(1, i))
- Next i
- End With
- End Sub
- Private Sub Form_Resize() '根据窗体大小来调整网格,标题栏大小(Fixed)
- On Error Resume Next
- With CxbbGrid
- .Width = Me.Width - 160
- .Height = Me.Height - .Top - 400
- End With
- With Pic_Title
- .Width = Me.Width - 160
- End With
- GsToolbar.Left = Me.Width - GsToolbar.Width - 140
- With Me.PB_Proc
- .Left = (Me.Width - .Width) / 2
- .Top = Me.Height / 2
- End With
- End Sub
- Private Sub Form_Load() '窗体装入
- On Error GoTo ErrCtrl
- '调入打印页面设置窗体
- Dim rs As New ADODB.Recordset
- Dim s As String
- s = "SELECT * FROM PM_ReportSort WHERE RCode='" & Me.sRCode & "'"
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- With rs
- If Not .EOF() Then
- ReportTitle = Trim(!RTitle & "")
- XtReportCode = Trim(!RPrintParama & "")
- End If
- End With
- Load Dyymctbl
- Me.Caption = ReportTitle
- Me.Lab_Title = ReportTitle
- '调整标题栏及网格、格式工具条位置(Fixed)
- Pic_Title.Left = 40
- Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
- CxbbGrid.Left = Pic_Title.Left
- CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
- '调 入 网 格(Fixed)
- GridCode = "Pm_RepSalary"
- Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
- Me.CxbbGrid.RowHidden(0) = True
- Me.CxbbGrid.RowHidden(1) = True
- Me.CxbbGrid.RowHidden(2) = True
- Qslz = GridInf(1)
- Sjhgd = GridInf(2)
- Sfxshjwg = GridInf(7)
- Szzls = CxbbGrid.Cols - 1
- iBeginCol = Val(GridInf(1))
- Exit Sub
- ErrCtrl:
- MsgBox "初始化错误!", vbOKOnly + vbCritical
- Set Dyymctbl = Nothing
- Unload Me
- End Sub
- Private Sub Form_Unload(Cancel As Integer) '窗体卸载
- '卸载打印页面设置窗体
- Dim gnsy As String
- Unload Dyymctbl
- Set Dyymctbl = Nothing
- Select Case sRCode
- Case "001"
- gnsy = "Pm_SalarySignal"
- Case "002"
- gnsy = "Pm_RepSalaryPay"
- Case "003"
- gnsy = "Pm_RepSalarySum"
- End Select
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- End Sub
- Private Function SaveGridFormat() As Boolean '保存网格格式
- On Error GoTo ErrCtrl
- Dim i As Integer
- Dim s As String
- Dim sTable As String
- Dim sField As String
- Dim bBeginTrans As Boolean
- '循环读取列名并拼成Sql语句
- With Me.CxbbGrid
- For i = IIf(iSumEndCol = -1, 0, iSumEndCol) To .Cols - 1
- If GetTableField(Trim(.TextMatrix(1, i)), sTable, sField, ".") = 1 Then
- s = s & " UPDATE PM_ReportItem SET FieldOrder=" & i - iSumEndCol & " ,FieldWidth=" & .ColWidth(i) & " ,FieldIsShow=" & IIf(.ColHidden(i), 0, 1) _
- & " WHERE TableName='" & sTable & "' AND FieldName='" & sField & "' AND RCode='" & Me.sRCode & "' AND PmSort='" & Me.sPmSort & "' " & Chr(10)
- End If
- Next i
- If Trim(s) <> "" Then
- Cw_DataEnvi.DataConnect.BeginTrans
- bBeginTrans = True
- Cw_DataEnvi.DataConnect.Execute (s)
- Cw_DataEnvi.DataConnect.CommitTrans
- bBeginTrans = False
- SaveGridFormat = True
- MsgBox "格式保存成功!", vnokonly + vbInformation
- End If
- End With
- Exit Function
- ErrCtrl:
- If bBeginTrans = True Then
- Cw_DataEnvi.DataConnect.RollbackTrans
- End If
- MsgBox "保存格式失败!", vbOKOnly + vbCritical
- End Function
- Private Sub CxbbGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long) '网格列发生移动时自动交换网格索引信息
- '分组汇总列不允许移动
- If Col <= iSumEndCol Then
- Position = Col
- Exit Sub
- End If
- '不允许列超过分组汇总列
- If Position <= iSumEndCol Then
- Position = iSumEndCol + 1
- Exit Sub
- End If
- End Sub
- Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '网格格式调整(Fixed)
- Select Case Button.Key
- Case "bcgs" '保存表格格式
- SaveGridFormat
- Case "hfmrgs" '恢复默认格式
- Call Hfmrgs(CxbbGrid, GridCode, GridStr())
- Case "szxsxm" '设置显示项目
- Dim frm As New Salary_ShowItem_Frm
- Set frm.vs = Me.CxbbGrid
- frm.iBeginCol = iSumEndCol + 1
- frm.Show 1
- Set frm = Nothing
- End Select
- End Sub
- Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
- On Error Resume Next
- Dim frm As Form
- Select Case Button.Key
- Case "ymsz" '页面设置
- Dyymctbl.Show 1
- Case "yl" '预 览
- PrintGrid Me.CxbbGrid, iBeginCol, iSumEndCol, Me.sRCode, Dyymctbl, Me.Lab_Period.Caption, False
- Case "dy" '打 印
- PrintGrid Me.CxbbGrid, iBeginCol, iSumEndCol, Me.sRCode, Dyymctbl, Me.Lab_Period.Caption, True
- Case "cx" '查 询
- Select Case UCase(Me.sPTableName)
- Case UCase("PM_AttendRecord")
- Set frm = New Query_RepAttend_Frm
- Case UCase("PM_PayRoll")
- Set frm = New Query_RepSalary_Frm
- End Select
- With frm
- .sPTableName = Me.sPTableName
- Set .frmParent = Me
- .sRCode = Me.sRCode
- .Show 1
- End With
- Case "Locate" '定位
- Set frm = New Locate_Frm
- With frm
- Set .frm = Me
- .Show 1
- End With
- Case "Refresh" '刷新数据
- ShowRecord sSqlWhere, sSqlFrom
- Case "Detail" '明细
- Call InitDetail
- Case "Total" '汇总
- Call InitTotal
- Case "bz" '帮 助
- Call F1bz
- Case "fh" '退 出
- Unload Me
- End Select
- Set frm = Nothing
- End Sub
- Public Function Locate(sPerson As String) As Integer '根据工号或姓名定位人员,成功返回1,没有找到返回0,错误返回-1
- On Error GoTo ErrCtrl
- Dim i As Long, j As Long
- Dim iCol(1) As Integer
- Dim bFound As Boolean
- sPerson = UCase(Trim(sPerson))
- With Me.CxbbGrid
- If .Rows = .FixedRows Then
- Exit Function
- End If
- If GetCol(sFieldValue, iCol(0), iCol(1), Val(GridInf(1))) <> 1 Then
- MsgBox "无法找到工号和姓名列,定位失败!", vbOKOnly + vbCritical
- GoTo ErrCtrl
- End If
- bFound = False
- For j = 0 To 1
- If iCol(j) >= 0 And bFound = False Then
- '从当前行的下一行找到末尾
- For i = .Row + 1 To .Rows - 1
- If UCase(Trim(.TextMatrix(i, iCol(j)))) = sPerson Then
- bFound = True
- .Row = i
- .TopRow = i
- Exit For
- End If
- Next i
- '如果没有找到,从数据开始行找到当前行
- If bFound = False Then
- For i = .FixedRows To .Row
- If UCase(Trim(.TextMatrix(i, iCol(j)))) = sPerson Then
- bFound = True
- .Row = i
- .TopRow = i
- Exit For
- End If
- Next i
- End If
- End If
- Next j
- If bFound = False Then
- Locate = 0
- Else
- Locate = 1
- End If
- End With
- Exit Function
- ErrCtrl:
- Locate = -1
- End Function
- Private Sub InitDetail() '显示或隐藏明细列
- On Error Resume Next
- Dim i As Integer
- Dim j As Integer
- Dim s As String
- '显示和隐藏非 小计和合计 列
- With Me.CxbbGrid
- .Redraw = False
- For j = Qslz To IIf(iSumEndCol = -1, 0, iSumEndCol)
- If Me.SzToolbar.Buttons("Detail").Value = tbrUnpressed Then
- For i = .FixedRows To .Rows - 2
- If Len(Trim(.TextMatrix(i, j))) >= 3 Then
- s = Right(Trim(.TextMatrix(i, j)), 3)
- Else
- s = .TextMatrix(i, j)
- End If
- If s <> "小计:" And s <> "合计:" Then
- .RowHidden(i) = True
- End If
- Next i
- Else
- For i = .FixedRows To .Rows - 2
- If Len(Trim(.TextMatrix(i, j))) >= 3 Then
- s = Right(Trim(.TextMatrix(i, j)), 3)
- Else
- s = .TextMatrix(i, j)
- End If
- If s <> "小计:" And s <> "合计:" Then
- .RowHidden(i) = False
- End If
- Next i
- End If
- Next j
- .Redraw = True
- End With
- End Sub
- Private Sub InitTotal() '显示或隐藏合计列
- On Error Resume Next
- Dim i As Integer
- Dim j As Integer
- Dim s As String
- '显示和隐藏小计和合计列
- With Me.CxbbGrid
- .Redraw = False
- For j = Qslz To IIf(iSumEndCol = -1, 0, iSumEndCol)
- If .FixedRows = .Rows Then Exit Sub
- If Me.SzToolbar.Buttons("Total").Value = tbrUnpressed Then
- For i = .FixedRows To .Rows - 1
- If Len(Trim(.TextMatrix(i, j))) >= 3 Then
- s = Right(Trim(.TextMatrix(i, j)), 3)
- Else
- s = ""
- End If
- If s = "小计:" Or s = "合计:" Then
- .RowHidden(i) = True
- End If
- Next i
- Else
- For i = .FixedRows To .Rows - 1
- If Len(Trim(.TextMatrix(i, j))) >= 3 Then
- s = Right(Trim(.TextMatrix(i, j)), 3)
- Else
- s = ""
- End If
- If s = "小计:" Or s = "合计:" Then
- .RowHidden(i) = False
- End If
- Next i
- End If
- Next j
- .Redraw = True
- End With
- End Sub
- Public Function ShowRecord(sWhere As String, sFrom As String) '生成查询结果(Define)
- On Error GoTo ErrCtrl
- Dim rs As New ADODB.Recordset
- Dim s As String
- Dim sTable As String
- Dim sField As String
- Dim sSql As String
- Dim i As Long
- If Trim(sWhere) = "" Or Trim(sFrom) = "" Then
- GoTo ErrCtrl
- End If
- Me.MousePointer = 11
- sExec = " SELECT 1 "
- ReDim sFieldValue(0)
- sFieldValue(0).FieldName = ""
- If Trim(Me.sGroupField) = "" Then '没有分组字段
- s = "SELECT rtrim(a.TableName) AS TableName " & Chr(10) _
- & ",rtrim(a.FieldName) AS FieldName " & Chr(10) _
- & ",rtrim(a.FieldWidth) AS FieldWidth " & Chr(10) _
- & ",rtrim(b.FieldLength) AS FieldLength " & Chr(10) _
- & ",rtrim(b.FieldDotL) AS FieldDotL " & Chr(10) _
- & ",rtrim(a.FieldIsShow) AS FieldIsShow " & Chr(10) _
- & ",rtrim(b.FieldType) AS FieldType " & Chr(10) _
- & ",rtrim(b.ChName) AS FieldNameC " & Chr(10) _
- & ",rtrim(b.CorTable) AS CorTable " & Chr(10) _
- & ",rtrim(b.IndexCode) AS IndexCode " & Chr(10) _
- & ",rtrim(b.IndexName) AS IndexName " & Chr(10) _
- & "FROM PM_ReportItem a INNER JOIN Rs_Items b ON a.FieldName =b.FieldName " & Chr(10) _
- & "WHERE a.RCode='" & Me.sRCode & "' AND a.PmSort='" & Me.sPmSort & "' " & Chr(10) _
- & "ORDER BY a.FieldOrder "
- iSumEndCol = Qslz - 1
- Else '有分组字段
- If GetTableField(Me.sGroupField, sTable, sField, ".") <> 1 Then
- MsgBox "分组汇总项目错误!", vbOKOnly + vbCritical
- Exit Function
- End If
- If UCase(sField) = UCase("DeptCode") Then '如果分组字段是部门,要进行分级
- s = "SELECT max(CodeLevel) AS MaxLevel FROM Gy_Department WHERE RsPmFlag=1"
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- If Not rs.EOF() Then
- For i = rs.Fields("MaxLevel") To Me.iDeptBeginLevel Step -1
- sExec = sExec & ",DeptLevel" & i & "=(SELECT b.DeptName FROM GY_Department b " _
- & " WHERE " & Me.sGroupField & " like rtrim(b.deptcode)+'%' AND b.CodeLevel= " & i & ")" & Chr(10)
- Next i
- iSumEndCol = Qslz + (Me.iDeptEndLevel - Me.iDeptBeginLevel)
- rs.Close
- s = "SELECT FieldWidth FROM PM_ReportItem WHERE FieldName='" & sField & "' AND TableName='" & sTable & "' AND RCode='" & sRCode & "'AND PmSort='" & Me.sPmSort & "' " & Chr(10)
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- If Not rs.EOF() Then
- For i = Me.iDeptBeginLevel To Me.iDeptEndLevel
- If sFieldValue(0).FieldName <> "" Then
- ReDim Preserve sFieldValue(UBound(sFieldValue) + 1)
- End If
- sFieldValue(UBound(sFieldValue)).FieldName = Me.sGroupField
- sFieldValue(UBound(sFieldValue)).FieldNameC = i & "级部门"
- sFieldValue(UBound(sFieldValue)).FieldValueName = "DeptLevel" & i
- sFieldValue(UBound(sFieldValue)).FieldType = DATA_STRING
- sFieldValue(UBound(sFieldValue)).FieldWidth = rs!FieldWidth
- sFieldValue(UBound(sFieldValue)).FieldIsShow = 1
- Next i
- End If
- rs.Close
- Set rs = Nothing
- Else
- MsgBox "不存在部门!", vbOKOnly + vbCritical
- Exit Function
- End If
- Else '其他分组字段
- s = "SELECT rtrim(a.TableName) AS TableName " & Chr(10) _
- & ",rtrim(a.FieldName) AS FieldName " & Chr(10) _
- & ",rtrim(a.FieldWidth) AS FieldWidth " & Chr(10) _
- & ",rtrim(a.FieldIsShow) AS FieldIsShow " & Chr(10) _
- & ",rtrim(b.ChName) AS FieldNameC " & Chr(10) _
- & ",rtrim(b.FieldType) AS FieldType " & Chr(10) _
- & ",rtrim(b.FieldLength) AS FieldLength " & Chr(10) _
- & ",rtrim(b.FieldDotL) AS FieldDotL " & Chr(10) _
- & ",rtrim(b.CorTable) AS CorTable " & Chr(10) _
- & ",rtrim(b.IndexCode) AS IndexCode " & Chr(10) _
- & ",rtrim(b.IndexName) AS IndexName " & Chr(10) _
- & "FROM PM_ReportItem a INNER JOIN Rs_Items b ON a.FieldName =b.FieldName " & Chr(10) _
- & "WHERE a.RCode='" & Me.sRCode & "' AND rtrim(a.TableName)+'.'+rtrim(a.FieldName)='" & Me.sGroupField & "' AND a.PmSort='" & Me.sPmSort & "' " & Chr(10) _
- & "ORDER BY a.FieldOrder "
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- With rs
- sFieldValue(UBound(sFieldValue)).FieldName = Me.sGroupField
- sFieldValue(UBound(sFieldValue)).FieldType = !FieldType
- sFieldValue(UBound(sFieldValue)).FieldNameC = Trim(!FieldNameC & "")
- sFieldValue(UBound(sFieldValue)).FieldWidth = !FieldWidth
- sFieldValue(UBound(sFieldValue)).FieldIsShow = !FieldIsShow
- sFieldValue(UBound(sFieldValue)).FieldLengthInt = !FieldLength - !FieldDotL
- sFieldValue(UBound(sFieldValue)).FieldLengthFra = !FieldDotL
- If Trim(!CorTable & "") <> "" Then
- sFieldValue(UBound(sFieldValue)).FieldValueName = Replace(Me.sGroupField, ".", "#") & "#N"
- sExec = sExec & ", " & sFieldValue(UBound(sFieldValue)).FieldValueName & " =" _
- & "(SELECT " & Trim(!IndexName) & " FROM " & Trim(!CorTable) & " a WHERE a." & Trim(!IndexCode) & "=" & Trim(!TableName) & "." & Trim(!FieldName) & ")" & Chr(10)
- Else
- sFieldValue(UBound(sFieldValue)).FieldValueName = Replace(Me.sGroupField, ".", "#")
- sExec = sExec & ", " & sFieldValue(UBound(sFieldValue)).FieldName & " AS " & sFieldValue(UBound(sFieldValue)).FieldValueName & Chr(10)
- End If
- End With
- rs.Close
- iSumEndCol = Qslz
- End If
- s = "SELECT rtrim(a.TableName) AS TableName " & Chr(10) _
- & ",rtrim(a.FieldName) AS FieldName " & Chr(10) _
- & ",rtrim(a.FieldWidth) AS FieldWidth " & Chr(10) _
- & ",rtrim(a.FieldIsShow) AS FieldIsShow " & Chr(10) _
- & ",rtrim(b.FieldType) AS FieldType " & Chr(10) _
- & ",rtrim(b.FieldLength) AS FieldLength " & Chr(10) _
- & ",rtrim(b.FieldDotL) AS FieldDotL " & Chr(10) _
- & ",rtrim(b.ChName) AS FieldNameC " & Chr(10) _
- & ",rtrim(b.CorTable) AS CorTable " & Chr(10) _
- & ",rtrim(b.IndexCode) AS IndexCode " & Chr(10) _
- & ",rtrim(b.IndexName) AS IndexName " & Chr(10) _
- & "FROM PM_ReportItem a INNER JOIN Rs_Items b ON a.FieldName =b.FieldName " & Chr(10) _
- & "WHERE a.RCode='" & Me.sRCode & "' AND rtrim(a.TableName)+'.'+rtrim(a.FieldName)<>'" & Me.sGroupField & "' AND a.PmSort='" & Me.sPmSort & "' " & Chr(10) _
- & "ORDER BY a.FieldOrder "
- End If
- '填充报表的其他字段信息
- Set rs = Cw_DataEnvi.DataConnect.Execute(s)
- With rs
- Do While Not .EOF()
- If sFieldValue(0).FieldName <> "" Then
- ReDim Preserve sFieldValue(UBound(sFieldValue) + 1)
- End If
- sFieldValue(UBound(sFieldValue)).FieldNameC = Trim(!FieldNameC)
- sFieldValue(UBound(sFieldValue)).FieldType = Trim(!FieldType)
- sFieldValue(UBound(sFieldValue)).FieldName = Trim(!TableName) & "." & Trim(!FieldName)
- sFieldValue(UBound(sFieldValue)).FieldWidth = !FieldWidth
- sFieldValue(UBound(sFieldValue)).FieldIsShow = !FieldIsShow
- sFieldValue(UBound(sFieldValue)).FieldLengthInt = !FieldLength - !FieldDotL
- sFieldValue(UBound(sFieldValue)).FieldLengthFra = !FieldDotL
- If Trim(!CorTable) <> "" Then
- sFieldValue(UBound(sFieldValue)).FieldValueName = Trim(!TableName) & "#" & Trim(!FieldName) & "#N"
- sExec = sExec & ", " & sFieldValue(UBound(sFieldValue)).FieldValueName & " =" _
- & "(SELECT " & Trim(!IndexName) & " FROM " & Trim(!CorTable) & " a WHERE a." & Trim(!IndexCode) & "=" & Trim(!TableName) & "." & Trim(!FieldName) & ")" & Chr(10)
- Else
- sFieldValue(UBound(sFieldValue)).FieldValueName = Trim(!TableName) & "#" & Trim(!FieldName)
- sExec = sExec & ", " & sFieldValue(UBound(sFieldValue)).FieldName & " AS " & sFieldValue(UBound(sFieldValue)).FieldValueName
- End If
- .MoveNext
- Loop
- .Close
- End With
- With Me.CxbbGrid
- '初始化网格
- .Redraw = False
- .Cols = UBound(sFieldValue) + 1 + Qslz
- .Rows = .FixedRows
- For i = Qslz To .Cols - 1
- .TextMatrix(0, i) = sFieldValue(i - Qslz).FieldType
- .TextMatrix(1, i) = sFieldValue(i - Qslz).FieldName
- .TextMatrix(2, i) = sFieldValue(i - Qslz).FieldValueName
- .TextMatrix(3, i) = sFieldValue(i - Qslz).FieldNameC
- .ColWidth(i) = sFieldValue(i - Qslz).FieldWidth
- .ColHidden(i) = IIf(sFieldValue(i - Qslz).FieldIsShow, False, True)
- Select Case Val(.TextMatrix(0, i))
- Case DATA_NUMERIC
- .ColAlignment(i) = flexAlignRightCenter
- .ColFormat(i) = IIf(sFieldValue(i - Qslz).FieldLengthFra = 0, "#,##0", "#,##0." & String(sFieldValue(i - Qslz).FieldLengthFra, "0"))
- Case DATA_DATE
- .ColAlignment(i) = flexAlignRightCenter
- .ColFormat(i) = "yyyy-mm-dd"
- Case Else
- .ColAlignment(i) = flexAlignLeftCenter
- .ColFormat(i) = ""
- End Select
- .FixedAlignment(i) = flexAlignCenterCenter
- .MergeCol(i) = False
- Next i
- For i = 0 To Qslz
- .ColFormat(i) = ""
- Next i
- .MergeCells = flexMergeFree
- For i = 0 To iSumEndCol
- .MergeCol(i) = True
- Next i
- '可执行Sql语句
- If Trim(Me.sGroupField) <> "" Then
- If Len(Me.sGroupField) > 5 Then
- If UCase(Mid(Me.sGroupField, Len(Me.sGroupField) - 4, 5)) = UCase("EmpNo") Then
- sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY " & Me.sGroupField
- Else
- sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY " & Me.sGroupField & ",PM_PayRoll.EmpNo "
- End If
- Else
- sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY " & Me.sGroupField & ",PM_PayRoll.EmpNo "
- End If
- Else
- sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY PM_PayRoll.DeptCode,PM_PayRoll.EmpNo "
- End If
- Set rs = Cw_DataEnvi.DataConnect.Execute(sExec)
- .Rows = .FixedRows + rs.RecordCount
- '初始化进度条
- Me.PB_Proc.Min = .FixedRows
- Me.PB_Proc.Max = .Rows + 1
- Me.PB_Proc.Value = Me.PB_Proc.Min
- Me.PB_Proc.Visible = True
- '填充数据
- For i = .FixedRows To .Rows - 1
- .RowHeight(i) = Sjhgd
- Me.PB_Proc.Value = i
- For j = Qslz To .Cols - 1
- If .TextMatrix(0, j) = DATA_NUMERIC Then
- .TextMatrix(i, j) = Val(Trim(rs.Fields(Trim(.TextMatrix(2, j))) & ""))
- If Val(.TextMatrix(i, j)) = 0 Then
- .TextMatrix(i, j) = ""
- End If
- Else
- .TextMatrix(i, j) = Trim(rs.Fields(Trim(.TextMatrix(2, j))) & "")
- End If
- Next j
- rs.MoveNext
- Next i
- rs.Close
- Me.PB_Proc.Visible = False
- '计算合计
- .SubtotalPosition = flexSTBelow
- For i = Qslz To iSumEndCol
- For j = iSumEndCol + 1 To .Cols - 1
- If .TextMatrix(0, j) = DATA_NUMERIC Then
- .Subtotal flexSTSum, i, j, , &HF7F3EC, , , "小计:"
- End If
- Next j
- Next i
- For j = iSumEndCol + 1 To .Cols - 1
- If .TextMatrix(0, j) = DATA_NUMERIC Then
- .Subtotal flexSTSum, -1, j, , &HF7F3EC, , , "合计:"
- End If
- Next j
- '填充合计信息
- If iSumEndCol < .Cols Then
- For i = .FixedRows To .Rows - 1
- For j = iBeginCol To iSumEndCol
- If .TextMatrix(i, j) = "小计:" Then
- If i > 1 Then .TextMatrix(i, j) = .TextMatrix(i - 1, j) & .TextMatrix(i, j)
- End If
- Next j
- Next i
- End If
- If Me.sRCode = "001" Then '工资签名表
- .Cols = .Cols + 1
- .ColWidth(.Cols - 1) = 1000
- .TextMatrix(.FixedRows - 1, .Cols - 1) = "签名"
- End If
- .Redraw = True
- End With
- Set rs = Nothing
- Me.MousePointer = 0
- Exit Function
- ErrCtrl:
- If rs.State = 1 Then
- rs.Close
- End If
- Set rs = Nothing
- Me.PB_Proc.Visible = False
- Me.CxbbGrid.Redraw = True
- Me.MousePointer = 0
- End Function
- Private Sub bbyl(bbylte As Boolean) '报表打印预览
- Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
- Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
- Bbxbtgs = 1 '报 表 小 标 题 行 数
- Bbbwhgs = 0 '报 表 表 尾 行 数
- ReDim Bbxbt(1 To Bbxbtgs)
- ReDim bbxbtzzxs(1 To Bbxbtgs)
- If Bbbwhgs <> 0 Then
- ReDim Bbbwh(1 To Bbbwhgs)
- ReDim Bbbwhzzxs(1 To Bbbwhgs)
- End If
- Bbzbt = ReportTitle
- bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
- Call Scyxsjb(CxbbGrid) '生成报表数据
- Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
- If Not bbylte Then
- Unload DY_Tybbyldy
- End If
- End Sub
