VB开发的ERP系统

        MsgBox "导出失败!", vbOKOnly + vbCritical
    End If
End Function

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 sField()
    Dim sBank()
    Dim bNoRecord As Boolean
    Dim sData() As String
    Dim iPos() As Long
    Dim i As Long
    Dim j As Long
    Dim m As Long
    Dim n As Integer
    Dim lValue As Long
    
    Me.MousePointer = 11
    '初始化数组
    ReDim iPos(0)
    iPos(0) = -1
    
    '设置标签
    Me.Lab_Value(0).Caption = Me.sSortName
    Me.Lab_Value(1).Caption = Me.sBankName
    Me.Lab_Value(2).Caption = Xtyear & "年" & Me.iPeriod & "月"
    '设置默认网格属性
    With Me.CxbbGrid
        .Rows = .FixedRows
        .Cols = 1
    End With
    '读取银行设置
    s = "select FileType,BKDot,BkThous,BkBitChar,BKCharType,BkBitVal,BkValType,BkSep,BkSepType,ColTitle" & Chr(10) _
        & " from PM_Bank WHERE BankCode='" & Me.sBankCode & "'"
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        If .EOF() Then
            Me.Lab_Value(3).Caption = 0
            MsgBox "没有银行信息!", vbOKOnly + vbCritical
            GoTo ErrCtrl
        Else
            ReDim sBank(.Fields.Count - 1)
            For j = 0 To .Fields.Count - 1
                sBank(j) = .Fields(j)
            Next j
            iFileType = !FileType
            bColTitle = !ColTitle
            iBkSepType = !bkseptype
        End If
        .Close
    End With
    
    '读取字段信息
    s = "select ColumnName,DataType,DataLen,DotLen,DataContent,Single,BkRoundType,AutoAdd1,SourceField " & Chr(10) _
        & " from PM_BankItem WHERE SortId='" & Me.sSortID & "' AND BankCode='" & Me.sBankCode & "' order by OrderNo"
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        If rs.EOF() Then
            Me.Lab_Value(3).Caption = 0
            MsgBox "没有设置代发项目!", vbOKOnly + vbCritical
            GoTo ErrCtrl
        Else
            ReDim sField(.RecordCount - 1, .Fields.Count - 1)
            For i = 0 To .RecordCount - 1
                For j = 0 To .Fields.Count - 1
                    sField(i, j) = Trim(.Fields(j) & "")
                Next j
                .MoveNext
            Next i
        End If
        .Close
    End With
    
    '读取数据信息
    s = ""
    For i = 0 To UBound(sField)
        If Trim(sField(i, 8)) <> "" Then
            ReDim Preserve iPos(UBound(iPos) + 1)
            iPos(UBound(iPos)) = i
            s = s & "," & Trim(sField(i, 8)) & " as " & Replace(Trim(sField(i, 8)), ".", "#") & Chr(10)
        End If
    Next i
    s = Trim(s)
    If s <> "" Then
        s = Mid(s, 2, Len(s) - 1)
        s = " select " & s & sSqlFrom & sSqlWhere
        Set rs = Cw_DataEnvi.DataConnect.Execute(s)
        With rs
            If .EOF() Then
                bNoRecord = True
                Me.Lab_Value(3) = 0
            Else
                Me.Lab_Value(3) = .RecordCount
                ReDim sData(.RecordCount, .Fields.Count - 1)
                For i = 0 To .RecordCount - 1
                    For j = 0 To .Fields.Count - 1
                        sData(i, j) = Trim(.Fields(j) & "")
                        sData(UBound(sData), j) = Val(sData(UBound(sData), j)) + Val(Trim(.Fields(j) & ""))
                    Next j
                    .MoveNext
                Next i
            End If
            .Close
        End With
    End If
    
    '初始化网格
    With Me.CxbbGrid
        .Rows = .FixedRows
        .Cols = GridInf(1) + UBound(sField) + 1
        For i = GridInf(1) To .Cols - 1
            .TextMatrix(.FixedRows - 1, i) = sField(i - GridInf(1), 0)
            .FixedAlignment(i) = flexAlignCenterCenter
            .ColWidth(i) = (sField(i - GridInf(1), 2) + 2) * 105
            If sField(i - GridInf(1), 1) = DATA_NUMERIC Then
                .ColAlignment(i) = flexAlignRightCenter
            Else
                .ColAlignment(i) = flexAlignLeftCenter
            End If
        Next i
    End With
    
    '初始化进度条
    Me.Fm_Proc.Visible = True
    Me.Fm_Proc.Caption = "正在格式化系统数据..."
    Me.PB_Proc.Min = 0
    If bNoRecord = False Then
        Me.PB_Proc.Max = UBound(iPos) * (UBound(sData) + 1) + 1
    Else
        Me.PB_Proc.Max = 1
    End If
    Me.PB_Proc.Value = 0
    
    '格式化数据
    If bNoRecord = False Then
        For i = 1 To UBound(iPos)
            If sField(iPos(i), 1) = DATA_NUMERIC Then '数字类型
                For j = 0 To UBound(sData)
                    Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                    If Val(sField(iPos(i), 3)) = 0 Then '小数位数为0
                        sData(j, i - 1) = Format(sData(j, i - 1), "###0")
                    Else
                        sData(j, i - 1) = Format(sData(j, i - 1), "###0." & String(Val(sField(iPos(i), 3)), "0"))
                    End If
                   
                    If sBank(2) = True Then '数据类型输出千分符
                        If Val(sField(iPos(i), 3)) = 0 Then '小数位数为0
                            sData(j, i - 1) = Format(sData(j, i - 1), "#,##0")
                        Else
                            sData(j, i - 1) = Format(sData(j, i - 1), "#,##0." & String(Val(sField(iPos(i), 3)), "0"))
                        End If
                    End If
                    
                    If sBank(1) = False Then '数据类型不输出小数点
                        sData(j, i - 1) = Replace(sData(j, i - 1), ".", "")
                    End If
                    
                    If sBank(5) = True Then '数字型数据有补位符
                        n = IIf(sField(iPos(i), 2) - Len(sData(j, i - 1)) > 0, sField(iPos(i), 2) - Len(sData(j, i - 1)), 0)
                        If sBank(6) = 1 Then  ' 补空格
                            sData(j, i - 1) = String(n, " ") & sData(j, i - 1)
                        Else
                            sData(j, i - 1) = String(n, "0") & sData(j, i - 1)
                        End If
                    End If
                    
                    '括项目的符号类型
                    sData(j, i - 1) = sField(iPos(i), 6) & sData(j, i - 1) & sField(iPos(i), 6)
                Next j
            Else '字符型
                For j = 0 To UBound(sData)
                    Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                    If sBank(3) = True Then '数字型数据有补位符
                        n = IIf(sField(iPos(i), 2) - LenByte(sData(j, i - 1)) > 0, sField(iPos(i), 2) - LenByte(sData(j, i - 1)), 0)
                        If sBank(4) = 1 Then ' 补空格
                            sData(j, i - 1) = sData(j, i - 1) & String(n, " ")
                        Else
                            sData(j, i - 1) = sData(j, i - 1) & String(n, "0")
                        End If
                    End If
                    
                    '括项目的符号类型
                    sData(j, i - 1) = sField(iPos(i), 6) & sData(j, i - 1) & sField(iPos(i), 6)
                Next j
                
            End If
        Next i
    End If
    
    '初始化进度条
    Me.Fm_Proc.Visible = True
    Me.Fm_Proc.Caption = "正在填充数据..."
    Me.PB_Proc.Min = 0
    If bNoRecord = False Then
        Me.PB_Proc.Max = (UBound(sData) + 1) * (UBound(sField) + 1)
    Else
        Me.PB_Proc.Max = 1
    End If
    Me.PB_Proc.Value = 0
    '填充数据
    With Me.CxbbGrid
        If bNoRecord = True Then
            GoTo ErrCtrl
        End If
        .Rows = .FixedRows + UBound(sData) + 1
        For i = .FixedRows To .Rows - 1
            .RowHeight(i) = Sjhgd
        Next i
        For i = 0 To UBound(sField)
            m = IsInclude(iPos, i)
            If m > 0 Then '从字段取得的数据
                For j = .FixedRows To .Rows - 2
                    Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                    .TextMatrix(j, i + GridInf(1)) = sData(j - .FixedRows, m - 1)
                Next j
                If sField(i, 1) = DATA_NUMERIC Then
                    .TextMatrix(.Rows - 1, i + GridInf(1)) = sData(UBound(sData), m - 1)
                End If
            Else '用户定义的数据
                If sField(i, 7) = True Then '自动加1
                    For j = .FixedRows To .Rows - 2
                        Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                        s = j - .FixedRows + 1
                        If sBank(2) = True Then '数据类型输出千分符
                            If Val(sField(i, 3)) = 0 Then '小数位数为0
                                s = Format(s, "#,##0")
                            Else
                                s = Format(s, "#,##0." & String(Val(sField(i, 3)), "0"))
                            End If
                        End If
                        
                        If sBank(1) = False Then '数据类型不输出小数点
                            s = Replace(s, ".", "")
                        End If
                        
                        If sBank(5) = True Then '字符型数据有补位符
                            n = IIf(sField(i, 2) - Len(s) > 0, sField(i, 2) - Len(s), 0)
                            If sBank(6) = 1 Then  ' 补空格
                                s = String(n, " ") & s
                            Else
                                s = String(n, "0") & s
                            End If
                        End If
                                        
                        '括项目的符号类型
                        s = sField(i, 6) & s & sField(i, 6)
                        .TextMatrix(j, GridInf(1) + i) = s
                    Next j
                Else '不是自动加1
                    s = sField(i, 4)
                    If sField(i, 1) = DATA_NUMERIC Then '用户录入数字型数据
                            If Val(sField(i, 3)) = 0 Then '小数位数为0
                                s = Format(s, "###0")
                            Else
                                s = Format(s, "###0." & String(Val(sField(iPos(i), 3)), "0"))
                            End If
                            
                            If sBank(2) = True Then '数据类型输出千分符
                                If Val(sField(i, 3)) = 0 Then '小数位数为0
                                    s = Format(s, "#,##0")
                                Else
                                    s = Format(s, "#,##0." & String(Val(sField(i, 3)), "0"))
                                End If
                            End If
                            
                            If sBank(1) = False Then '数据类型不输出小数点
                                s = Replace(s, ".", "")
                            End If
                            
                            If sBank(5) = True Then '数字型数据有补位符
                                n = IIf(sField(i, 2) - Len(s) > 0, sField(i, 2) - Len(s), 0)
                                If sField(i, 6) = 1 Then ' 补空格
                                    s = String(n, " ") & s
                                Else
                                    s = String(n, "0") & s
                                End If
                            End If
                                            
                            '括项目的符号类型
                            s = sField(i, 6) & s & sField(i, 6)
                        For j = .FixedRows To .Rows - 2
                            Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                            .TextMatrix(j, GridInf(1) + i) = s
                        Next j
                    Else '用户录入字符型值
                        s = sField(i, 4) '数据内容
                        If sBank(3) = True Then '字符型数据有补位符
                            n = IIf(sField(i, 2) - LenByte(s) >= 0, sField(i, 2) - LenByte(s), 0)
                            If sBank(4) = 1 Then ' 补空格
                                s = s & String(n, " ")
                            Else
                                s = s & String(n, "0")
                            End If
                        End If
                        '括项目的符号类型
                        s = sField(i, 6) & s & sField(i, 6)
                        For j = 0 To UBound(sData) - 1
                            Me.PB_Proc.Value = (Me.PB_Proc.Value + 1) Mod Me.PB_Proc.Max
                            .TextMatrix(.FixedRows + j, i + GridInf(1)) = s
                        Next j
                    End If
                End If
            End If
        Next i
        If .Rows > .FixedRows And .Cols > .FixedCols And Val(GridInf(1)) >= 0 Then
            If Trim(.TextMatrix(.Rows - 1, Val(GridInf(1)))) = "" Then
                .TextMatrix(.Rows - 1, Val(GridInf(1))) = "合计:"
            End If
            .Cell(flexcpBackColor, .Rows - 1, 0, .Rows - 1, .Cols - 1) = &HF7F3EC
        End If
    End With
    Me.MousePointer = 0
    Me.Fm_Proc.Visible = False
    If rs.State = 1 Then
        rs.Close
    End If
    Set rs = Nothing
    Exit Function
    
ErrCtrl:
    Me.Fm_Proc.Visible = False
    Me.MousePointer = 0
    If rs.State = 1 Then
        rs.Close
    End If
    Set rs = Nothing
    
End Function

Private Function IsInclude(iArr() As Long, iValue As Long) As Long
    '数组iArr是否包涵iValue
    Dim i As Long
    For i = LBound(iArr) To UBound(iArr)
        If iArr(i) = iValue Then
            IsInclude = i
            Exit Function
        End If
    Next i
    
    If i > UBound(iArr) Then
        IsInclude = -1
    End If
        
End Function

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    Dim i As Integer
    Dim s As String
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 2                                         '报 表 小 标 题 行 数
    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
    For i = 0 To Me.Lab_Mark.Count - 1
        s = s & Me.Lab_Mark(i).Caption & Me.Lab_Value(i).Caption & "          "
    Next i
    Bbxbt(2) = s
    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