VB开发的ERP系统

               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             =   "dw"
            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             =   "zz"
            EndProperty
            BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "因素分析_因素趋势分析结果.frx":3C7E0
               Key             =   "mx"
            EndProperty
            BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "因素分析_因素趋势分析结果.frx":3CB7A
               Key             =   "lj"
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "YX_FrmQsFx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*    模 块 名 称 :因素趋势分析结果
'*    功 能 描 述 :
'*    程序员姓名  :魏永生
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*********************************************************************

Option Explicit
Private Const strJ = "借方发生额"
Private Const strD = "贷方发生额"
Private Const strJe = "余额"
Private Const COL_WIDTH = 1650              '网格列宽
Private Const strJF = "借"
Private Const strDF = "贷"
Dim ReportTitle As String                   '报表主标题

Dim myclsBal As New clsBal                  '资产负债表类
Dim myclsInc As New clsInc                  '损益表类
    Dim Int_Curr_year As Integer            '分析期年
    Dim Int_Curr_month1 As Integer          '分析期开始月
    Dim Int_Curr_month2 As Integer          '分析期结束月
Dim SumRs As New ADODB.Recordset            '总账记录集
Dim CodeRs As New ADODB.Recordset           '科目记录集
    
'以下为固定使用变量
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 Form_Resize()                '根据窗体大小来调整网格,标题栏大小
    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 - 160
End Sub

Private Sub Form_Load()                  '窗体装入
    
    '调入打印页面设置窗体
    ReportTitle = "因素趋势分析"
    
    XtReportCode = "cwfx_YsqsFx"
    Load Dyymctbl
    
    '调整标题栏及网格、格式工具条位置
    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
    
    '调 入 网 格
    GridCode = "cwfx_YsqsFx"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    myclsBal.Init Cw_DataEnvi.DataConnect
    myclsInc.Init Cw_DataEnvi.DataConnect
    
    CodeRs.Open "select * from cwzz_AccCode", Cw_DataEnvi.DataConnect, adOpenDynamic
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    '卸载条件窗体
    YX_FrmAccountDeptC.UnloadCheck.Value = 1
    Unload YX_FrmAccountDeptC
    '卸载打印页面设置窗体
    Unload Dyymctbl
    Set myclsBal = Nothing
    Set myclsInc = Nothing
    CodeRs.Close
    Set CodeRs = Nothing
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整
    Select Case Button.Key
    Case "bcgs"                                          '保存表格格式
        Call Bcwggs(CxbbGrid, GridCode, GridStr())
    Case "hfmrgs"                                        '恢复默认格式
        Call Hfmrgs(CxbbGrid, GridCode, GridStr())
    Case "szxsxm"                                        '设置显示项目
        Call Szxsxm(CxbbGrid, GridCode)
    End Select
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "cx"                                            '查 询
        YX_FrmQsSeach.Show 1
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    Timer1.Enabled = False
    If DEBUG_FLAG = False Then
        On Error Resume Next
        XT_Wait.Show
        XT_Wait.Refresh
    End If
    
    '加快显示速度
    CxbbGrid.Redraw = False
    GridCode = "cwfx_YsqsFx"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    '生成查询结果
    Call Sub_Query
    
    CxbbGrid.Redraw = True
    If DEBUG_FLAG = False Then
        XT_Wait.Hide
    End If
End Sub

Private Sub Sub_Query()                                    '生成查询结果
    Dim Rec_Query As New ADODB.Recordset                   '查询结果动态集
    Dim temRs As New ADODB.Recordset                       '查询
    
    Dim SqlStr As String                                   '查询动态连接字符串
    
    Dim I As Integer
    Dim j As Integer
    Dim Str_Ccode As String                         '科目
    Dim Str_AccountType As String                   '科目方向
    Dim dbl_Value As Double                         '数据
    Dim dbl_Total As Double                         '合计数据
    Dim int_Months As Integer                       '月数
    '以下为用户自定义部分[
    
    
    Int_Curr_year = Xtyear
    Int_Curr_month1 = Val(Right(YX_FrmQsSeach.Combo_DateBegin.Text, 2))
    Int_Curr_month2 = Val(Right(YX_FrmQsSeach.Combo_DateEnd.Text, 2))
    
    With YX_FrmQsSeach.CxbbGridR
        For I = .FixedRows To .Rows - 1
            Me.CxbbGrid.AddItem ""
            Me.CxbbGrid.RowHeight(I) = Sjhgd
            Me.CxbbGrid.TextMatrix(Me.CxbbGrid.Rows - 1, 1) = .TextMatrix(I, 2)
        Next
        
        For I = Int_Curr_month1 To Int_Curr_month2
            With Me.CxbbGrid
                .Cols = .Cols + 1
                .ColWidth(.Cols - 1) = COL_WIDTH
                .ColAlignment(.Cols - 1) = 6
                .FixedAlignment(.Cols - 1) = flexAlignCenterCenter
                .ColFormat(.Cols - 1) = "#,##0.00"
                .TextMatrix(.FixedRows - 1, .Cols - 1) = Int_Curr_year & "\" & Format(I, "00")
            End With
        Next
        
        With Me.CxbbGrid
            .Cols = .Cols + 1
            .ColAlignment(.Cols - 1) = 6
            .FixedAlignment(.Cols - 1) = flexAlignCenterCenter
            .ColWidth(.Cols - 1) = COL_WIDTH
            .ColFormat(.Cols - 1) = "#,##0.00"
            .TextMatrix(.FixedRows - 1, .Cols - 1) = "平均值"
        End With
        
        
        int_Months = (Int_Curr_month2 - Int_Curr_month1) + 1    '月数
        
        For I = .FixedRows To .Rows - 1
            Str_Ccode = .TextMatrix(I, 1)
            Str_AccountType = .TextMatrix(I, 3)
            dbl_Total = 0                                       '合计数据置零
            dbl_Value = 0
            If Str_Ccode = "" Then
                For j = Sydz("001", GridStr(), Szzls) + 1 To Me.CxbbGrid.Cols - 2
                    
                    dbl_Value = myclsBal.GetPeriodValue("资产合计", Val(Right(Me.CxbbGrid.TextMatrix(0, j), 2)), Int_Curr_year)
                    dbl_Total = dbl_Total + dbl_Value
                    Me.CxbbGrid.TextMatrix(I, j) = IIf(dbl_Value = 0, "", dbl_Value)
                Next
                Me.CxbbGrid.TextMatrix(I, j) = IIf(dbl_Total = 0, "", dbl_Total / int_Months)
            Else
                For j = Sydz("001", GridStr(), Szzls) + 1 To Me.CxbbGrid.Cols - 2
                    SqlStr = "select * from Cwzz_AccSum where ccode='" & Str_Ccode & "' and Year=" & Int_Curr_year & " and Period=" & Val(Right(Me.CxbbGrid.TextMatrix(0, j), 2))
                    Set SumRs = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Not (SumRs.EOF And SumRs.BOF) Then
                        CodeRs.MoveFirst
                        CodeRs.Find "cCode='" & Str_Ccode & "'"
                        If Not CodeRs.EOF Then
                            Select Case Str_AccountType
                            Case strJ
                                dbl_Value = SumRs!Mjje
                            Case strD
                                dbl_Value = SumRs!Mdje
'******如果将来需加入统计借贷方差额的功能
'                            Case strJe
'                                '--------------------------
'                                If Trim(CodeRs!BalanceOri) = "借" Then
'                                    dbl_Value = SumRs!Mjje - SumRs!Mdje
'                                Else
'                                    dbl_Value = SumRs!Mdje - SumRs!Mjje
'                                End If
'                                '---------------------------------
'****************
                            Case strJe
                                dbl_Value = SumRs!qmye
                            End Select
                        End If
                    End If
                    dbl_Total = dbl_Total + dbl_Value
                    Me.CxbbGrid.TextMatrix(I, j) = IIf(dbl_Value = 0, "", dbl_Value)
                Next
                If int_Months = 0 Then
                    Me.CxbbGrid.TextMatrix(I, j) = ""
                Else
                    Me.CxbbGrid.TextMatrix(I, j) = IIf(dbl_Total = 0, "", dbl_Total / int_Months)
                End If
            End If
            
        Next
    End With
End Sub

Private Function FormatValue(ByVal dbl_PastVal, ByVal intValType As Integer) As Double
    '格式化数值
    Dim dbl_Value As Double
    Select Case intValType
        
    End Select
    FormatValue = dbl_Value
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
    Bbxbt(1) = Space(2) & Lab_TitleText(0).Caption
    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