VB开发的ERP系统

       An_RsAgeLongFrmQuery.Show 1
    Case "DingYi"                                        '定 义
       '判断用户是否有此功能执行权限,如有则写上机日志(进入)
        If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
            Exit Sub
        End If
       An_RsSetAgeLongFrm.Show 1
    
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
End Sub
Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    
    Timer1.Enabled = False
    Xt_Wait.Show
    Xt_Wait.Refresh
    
    '加快显示速度
    CxbbGrid.Redraw = False
    
    '生成查询结果
    ShowRecord
    
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
    
End Sub

Public Function ShowRecord()                                  '生成查询结果(Define)

    '显示数据
    On Error GoTo ErrCtrl
    

    Dim rs As New ADODB.Recordset
    Dim rec_num As New ADODB.Recordset
    Dim s As String
    Dim i As Long
    Dim j As Long

    Dim sFrom As String
    Dim str_Temp As String
    Dim Age() As Integer
    Dim int_sum() As Integer
    
    
    If Trim(Me.sSqlWhereMore) = "" Then
        Me.sSqlWhereMore = " 1=1 "
    End If
    
    If Trim(Me.sSqlWhere) = "" Then
        GoTo ErrCtrl
    End If
    Me.MousePointer = 11
    
    With Me.CxbbGrid
        '初始化网格
        .Redraw = False
        .Rows = .FixedRows
        .Cols = Qslz + 4
        .FixedCols = .Cols
    
    '填充年资段
        s = "select  ItemName,ItemParameter from Rs_OtherSet where ItemProperty=2 order by ItemName"
        Set rs = Cw_DataEnvi.DataConnect.Execute(s)
        If rs.EOF() Then
            MsgBox "没有设置年资段!", vbOKOnly + vbCritical
            GoTo ErrCtrl
        End If
        .Cols = .FixedCols + 2 * rs.RecordCount + 4
        ReDim Age(.Cols)
        ReDim int_sum(.Cols)
        
        i = .FixedCols
        
        Age(i - 2) = "0"  '年资段最小值
        int_sum(0) = 0
        
        
        Do While Not rs.EOF()
            Age(i) = Val(Trim(rs.Fields("ItemParameter") & "")) '年资段上限
            
            str_Temp = Age(i - 2) & "-" & Age(i) & "月"
            
            .TextMatrix(.FixedRows - 1, i) = str_Temp
            .TextMatrix(.FixedRows - 1, i + 1) = "百分比%"
            
            '调整网格格式
            .ColAlignment(i) = flexAlignRightCenter
            .ColAlignment(i + 1) = flexAlignRightCenter
            .FixedAlignment(i) = flexAlignCenterCenter
            .FixedAlignment(i + 1) = flexAlignCenterCenter
            i = i + 2
            rs.MoveNext
        Loop
        rs.Close
        str_Temp = Age(i - 2) & "月以上"
        .TextMatrix(.FixedRows - 1, .Cols - 4) = str_Temp
        .TextMatrix(.FixedRows - 1, .Cols - 3) = "百分比%"
        .TextMatrix(.FixedRows - 1, .Cols - 2) = "未   知"
        .TextMatrix(.FixedRows - 1, .Cols - 1) = "百分比%"
        
        '调整网格格式
        .ColAlignment(.Cols - 2) = flexAlignRightCenter
        .ColAlignment(.Cols - 1) = flexAlignRightCenter
        .FixedAlignment(.Cols - 2) = flexAlignCenterCenter
        .FixedAlignment(.Cols - 1) = flexAlignCenterCenter

        '填充部门和部门人数
        s = " select Gy_Department.DeptCode ,Gy_Department.DeptName,Gy_Department.CodeLevel " & Chr(10) _
            & " ,Num=(select count(*) from Rs_BasicInfo  " & Chr(10) _
            & "where  left(Rs_BasicInfo.DeptCode,len(Gy_Department.DeptCode))=Gy_Department.DeptCode  and " & Me.sSqlWhereMore & ") " & Chr(10) _
            & " from Gy_Department  " & Chr(10) _
            & Me.sSqlWhereMe
        Set rs = Cw_DataEnvi.DataConnect.Execute(s)

        If rs.EOF() Then
            GoTo ErrCtrl
        End If

        .Rows = .FixedRows + rs.RecordCount + 1
        i = .FixedRows
        Do While Not rs.EOF()
            .RowHeight(i) = Sjhgd
            .TextMatrix(i, Qslz) = Trim(rs.Fields("DeptCode") & "")
            .TextMatrix(i, Qslz + 1) = Trim(rs.Fields("DeptName") & "")
            .TextMatrix(i, Qslz + 2) = Val(rs.Fields("Num") & "")
            If Val(rs.Fields("CodeLevel") & "") = int_CodeLevel Then
                int_sum(0) = int_sum(0) + Val(rs.Fields("Num") & "")
            End If
            
            '填充平均年资
            s = " select num=avg(DateDiff(Month, HireTime, getdate())) from Rs_BasicInfo " & Chr(10) & _
                " where  Rs_BasicInfo.DeptCode like   '" & Trim(rs.Fields("DeptCode") & "") & "%'" & Chr(10) & _
                " and    " & Me.sSqlWhereMore & Chr(10)
                

            Set rec_num = Cw_DataEnvi.DataConnect.Execute(s)

            If Not rs.EOF() Then
                If rec_num.Fields("num") > 0 Then
                    .TextMatrix(i, .FixedCols - 1) = rec_num.Fields("num")
                End If
            End If
            rec_num.Close
            
            '填充年资段人数和百分比
            For j = .FixedCols To .Cols - 2 Step 2
                Select Case j
                    Case .Cols - 2
                        s = " select num=count(1) from Rs_BasicInfo " & Chr(10) & _
                            " where  Rs_BasicInfo.DeptCode like   '" & Trim(rs.Fields("DeptCode") & "") & "%'" & Chr(10) & _
                            " and    HireTime IS null " & Chr(10) & _
                            " and    " & Me.sSqlWhereMore & Chr(10)
                    Case .Cols - 4
                        s = " select num=count(1) from Rs_BasicInfo " & Chr(10) & _
                            " where  Rs_BasicInfo.DeptCode like   '" & Trim(rs.Fields("DeptCode") & "") & "%'" & Chr(10) & _
                            " and    DateDiff(Month, HireTime, getdate()) >= " & Val(Age(j - 2)) & Chr(10) & _
                            " and    " & Me.sSqlWhereMore & Chr(10)
                        
                    Case Else
                        s = " select num=count(1) from Rs_BasicInfo " & Chr(10) & _
                            " where  Rs_BasicInfo.DeptCode like   '" & Trim(rs.Fields("DeptCode") & "") & "%'" & Chr(10) & _
                            " and    DateDiff(Month, HireTime, getdate()) >= " & Val(Age(j - 2)) & " And DateDiff(Month, HireTime, getdate()) < " & Val(Age(j)) & Chr(10) & _
                            " and    " & Me.sSqlWhereMore & Chr(10)
                End Select

                Set rec_num = Cw_DataEnvi.DataConnect.Execute(s)

                If Not rs.EOF() Then
                    If rec_num.Fields("num") > 0 Then
                        .TextMatrix(i, j) = rec_num.Fields("num")
                        If Val(rs.Fields("CodeLevel") & "") = int_CodeLevel Then
                            int_sum(j) = int_sum(j) + rec_num.Fields("num")
                        End If

                        If Val(.TextMatrix(i, Qslz + 2)) <> 0 Then
                            .TextMatrix(i, j + 1) = Format(100 * Val(rec_num.Fields("Num") & "") / Val(.TextMatrix(i, Qslz + 2)), "##0.00")
                        End If
                    End If
                End If
                rec_num.Close
            Next j
            
            rs.MoveNext
            i = i + 1
        Loop
        rs.Close

        Set rs = Nothing
        '填充合计行
        .RowHeight(.Rows - 1) = Sjhgd
        .TextMatrix(.Rows - 1, Qslz) = "合计"
        .TextMatrix(.Rows - 1, Qslz + 1) = "合计"
        .TextMatrix(.Rows - 1, Qslz + 2) = int_sum(0)
                '填充平均年资
        s = " select num=avg(DateDiff(Month, HireTime, getdate())) from Rs_BasicInfo " & Chr(10) & _
            " inner join Gy_DepartMent on Left(Rs_BasicInfo.DeptCode, Len(Gy_Department.DeptCode)) = Gy_Department.DeptCode " & Chr(10) & _
              Me.sSqlWhereMe & " and " & Me.sSqlWhereMore
        


        Set rec_num = Cw_DataEnvi.DataConnect.Execute(s)

        If Not rec_num.EOF() Then
            If rec_num.Fields("num") > 0 Then
                .TextMatrix(.Rows - 1, Qslz + 3) = rec_num.Fields("num")
            End If
        End If
        rec_num.Close
            
        
        
        For j = .FixedCols To .Cols - 2 Step 2
            .Cell(flexcpBackColor, .Rows - 1, j) = &HF7F3EC
            .Cell(flexcpBackColor, .Rows - 1, j) = &HF7F3EC
            If int_sum(j) > 0 Then
                .TextMatrix(.Rows - 1, j) = int_sum(j)
                
                If Val(.TextMatrix(.Rows - 1, Qslz + 2)) <> 0 Then
                    .TextMatrix(.Rows - 1, j + 1) = Format(100 * int_sum(j) / Val(.TextMatrix(.Rows - 1, Qslz + 2)), "##0.00")
                End If
            End If
        
        Next j
        
        .Redraw = True
    End With
    Me.PB_Proc.Visible = False
    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