VB开发的ERP系统

            & ",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='" & 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='" & sPmSort & "' "
                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='" & 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) & 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='" & 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 & Chr(10)
            End If
            
            .MoveNext
        Loop
    End With
    rs.Close
        
    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
        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 InStr(1, UCase(sSqlFrom), UCase("Rs_BasicInfo")) > 0 Then
            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 & ",Rs_BasicInfo.EmpNo "
                    End If
                Else
                    sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY " & Me.sGroupField & ",Rs_BasicInfo.EmpNo "
                End If
            Else
                sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY Rs_BasicInfo.DeptCode,Rs_BasicInfo.EmpNo "
            End If
        Else
            If Trim(Me.sGroupField) <> "" Then
                sExec = sExec & Me.sSqlFrom & Me.sSqlWhere & " ORDER BY " & Me.sGroupField
            Else
                sExec = sExec & Me.sSqlFrom & Me.sSqlWhere
            End If
        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