z

财务分析 财财务分析务分析

                                End If
                                If dbl_BaseValue <> 0 And dbl_OldValue <> 0 Then
                                    dbl_Return = Format((dbl_OldValue / dbl_BaseValue * 100), "#,##0.##")
                                    CxbbGrid.TextMatrix(iRow, iCol) = IIf(dbl_Return = 0, "", CStr(dbl_Return) & "")
                                    CxbbGrid.RowData(iRow) = dbl_Return
                                ElseIf dbl_BaseValue = 0 And dbl_OldValue = 0 Then
                                    CxbbGrid.TextMatrix(iRow, iCol) = ""
                                ElseIf dbl_BaseValue = 0 And dbl_OldValue <> 0 Then
                                    CxbbGrid.TextMatrix(iRow, iCol) = "100"
                                    CxbbGrid.RowData(iRow) = dbl_OldValue
                                End If
                                
                        End Select
                    End If
                    iRow = iRow + 1
                    .MoveNext
                Loop
            End If
        End With
    Next iCol
   
End Sub
'Private Sub FillGrid2()
'    If DEBUG_FLAG = False Then On Error Resume Next
'    Dim iRow As Integer
'    Dim iCol As Integer
'    Dim dbl_Return As Double
'    Dim dbl_BaseValue As Double '本期数据
'    Dim dbl_OldValue As Double '上期数据
'    Dim dbl_Fx As Double
'    Dim dbl_Bj As Double
'    Dim dbl_Cha As Double
'    Dim dbl_Bi As Double
'    Dim dbl_ZiChan As Double
'    Dim dbl_fxBi As Double
'    Dim dbl_FuZhai As Double
'    Dim dbl_dbBi As Double
'    GridStarCol = 2
'        With Rs
'            iRow = CxbbGrid.FixedRows
'            If Not (.EOF And .BOF) Then
'                .MoveFirst
'                Do Until .EOF
'                    DoEvents
'                    If IsNull(!comment) = False Then
'                        '-----------------------------------
'                        If iRow > CxbbGrid.Rows Then CxbbGrid.AddItem ""
'                        lab_Fxq.Caption = "分析期:"
'                        If intType = 1 Then '季
'                            lab_fx.Caption = Space(6) & CStr(iThisYear) & DATE_FIX & CStr(iThisMonthBegin) & "-" & CStr(iThisYear) & DATE_FIX & CStr(iThisMonthEnd)
'                        Else
'                            lab_fx.Caption = Space(6) & CStr(iThisYear) & DATE_FIX & CStr(iThisMonthBegin)
'                        End If
'                        lab_Bjq.Caption = "比较期:"
'                        If intType = 1 Then '季
'                            lab_bj.Caption = Space(6) & CStr(iThisYear) & DATE_FIX & CStr(iCompMonthBegin) & "-" & CStr(iThisYear) & DATE_FIX & CStr(iCompMonthEnd)
'                        Else
'                            If iCompMonthEnd <> 0 Then
'                                lab_bj.Caption = Space(6) & CStr(iThisYear) & DATE_FIX & CStr(iCompMonthEnd)
'                            Else
'                                lab_bj.Caption = ""
'                            End If
'                        End If
'                        '---------------------------------------
'                        Select Case Me.strItem
'                            Case "cwfx_IncDb"
'                                dbl_Fx = TimeClass2(Trim(Rs!iTem), "002")
'                                dbl_Bj = TimeClass2(Trim(Rs!iTem), "003")
'                                dbl_Cha = dbl_Fx - dbl_Bj
'
'                                If dbl_Bj <> 0 Then
'                                    dbl_Bi = dbl_Cha / dbl_Bj
'                                End If
'
'                                With CxbbGrid
'
'                                    CxbbGrid.TextMatrix(iRow, Sydz("002", GridStr(), Szzls)) = IIf(dbl_Fx = 0, "", dbl_Fx)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("003", GridStr(), Szzls)) = IIf(dbl_Bj = 0, "", dbl_Bj)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("004", GridStr(), Szzls)) = IIf(dbl_Cha = 0, "", dbl_Cha)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("005", GridStr(), Szzls)) = IIf(dbl_Bi = 0, "", CStr(dbl_Bi) * 100)
'                                End With
'
'                        Case "cwfx_IncJg"
'                                dbl_Fx = TimeClass2(Trim(Rs.Fields(1).Value), "002")
'                                dbl_Bj = TimeClass2(Trim(Rs.Fields(1).Value), "004")
'
'                                If dbl_ZiChan <> 0 Then '如果资产合计<>0
'                                    dbl_fxBi = dbl_Fx / dbl_ZiChan  '分析期结构
'                                End If
'
'                                If dbl_FuZhai <> 0 Then
'                                    dbl_dbBi = dbl_Bj / dbl_FuZhai '比较期结构
'                                End If
'
'                                With CxbbGrid
'
'                                    CxbbGrid.TextMatrix(iRow, Sydz("002", GridStr(), Szzls)) = IIf(dbl_Fx = 0, "", dbl_Fx)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("003", GridStr(), Szzls)) = IIf(dbl_fxBi = 0, "", CStr(dbl_fxBi) * 100)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("004", GridStr(), Szzls)) = IIf(dbl_Bj = 0, "", dbl_Bj)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("005", GridStr(), Szzls)) = IIf(dbl_dbBi = 0, "", CStr(dbl_dbBi) * 100)
'                                    CxbbGrid.TextMatrix(iRow, Sydz("006", GridStr(), Szzls)) = IIf((dbl_fxBi - dbl_dbBi) = 0, "", CStr(dbl_fxBi - dbl_dbBi) * 100)
'                                End With
'                        End Select
'                    End If
'                    iRow = iRow + 1
'                    .MoveNext
'                Loop
'            End If
'        End With
'
'End Sub
Private Function TimeClass(ByVal ItemClass As String, ByVal iCol As Integer) As Double
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim iTemMonthBegin As Integer
    Dim iTemMonthEnd As Integer
    Dim iTemYear As Integer
    Select Case intType
        Case 0 '月
            iTemYear = Xtyear
            iTemMonthBegin = iThisMonthBegin
            iTemMonthEnd = iThisMonthEnd
            With CxbbGrid
                iTemMonthBegin = Right(.TextMatrix(.FixedRows - 1, iCol), 2)
                iTemMonthEnd = iTemMonthBegin
            End With
            TimeClass = myclsInc.GetPeriodValue(ItemClass, iTemMonthBegin, iTemMonthEnd, iTemYear)
        Case 1 '季
            iTemYear = Xtyear
'            iTemMonthBegin = iThisMonthBegin - 2
'            iTemMonthEnd = iThisMonthEnd
            iTemMonthBegin = Val(Mid(CxbbGrid.TextMatrix(CxbbGrid.FixedRows - 1, iCol), 6, 2))
            iTemMonthEnd = Val(Mid(CxbbGrid.TextMatrix(CxbbGrid.FixedRows - 1, iCol), 14, 2))
            TimeClass = myclsInc.GetPeriodValue(ItemClass, iTemMonthBegin, iTemMonthEnd, iTemYear)
        Case 2 '年
            iTemYear = Val(CxbbGrid.TextMatrix(CxbbGrid.FixedRows - 1, iCol))
            TimeClass = myclsInc.GetPeriodValue(ItemClass, 1, 12, iTemYear)
    End Select
End Function
Private Function TimeClass2(ByVal ItemClass As String, ByVal cCol As String) As Double
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim iTemMonthBegin As Integer
    Dim iTemMonthEnd As Integer
    Dim iTemYear As Integer
    itype = Me.intType
    Select Case itype
        Case 0 '月
            If cCol = "001" Or cCol = "002" Then '分析期
                iTemYear = iThisYear
                iTemMonthBegin = iThisMonthBegin
                iTemMonthEnd = iThisMonthEnd
            ElseIf cCol = "003" Or cCol = "004" Then '比较期
                iTemYear = iCompYear
                iTemMonthBegin = iCompMonthBegin
                iTemMonthEnd = iCompMonthEnd
            End If
            
            TimeClass2 = myclsInc.GetPeriodValue(ItemClass, iTemMonthBegin, iTemMonthEnd, iTemYear)
        
        Case 1 '季
            If cCol = "001" Or cCol = "002" Then '分析期
                iTemYear = iThisYear
                iTemMonthBegin = iThisMonthBegin
                iTemMonthEnd = iThisMonthEnd
            ElseIf cCol = "003" Or cCol = "004" Then '比较期
                iTemYear = iCompYear
                iTemMonthBegin = iCompMonthBegin
                iTemMonthEnd = iCompMonthEnd
            End If
            
            TimeClass2 = myclsInc.GetPeriodValue(ItemClass, iTemMonthBegin, iTemMonthEnd, iTemYear)
        Case 2 '年
            If cCol = "001" Or cCol = "002" Then  '分析期
                iTemYear = iThisYear
            ElseIf cCol = "003" Or cCol = "004" Then '比较期
                iTemYear = iCompYear
            End If
            
            TimeClass2 = myclsInc.GetPeriodValue(ItemClass, 1, 12, iTemYear)
    End Select
End Function

'========================================================================



























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_Unload(Cancel As Integer)
   If DEBUG_FLAG = False Then On Error Resume Next
   '卸载打印页面设置窗体
   Unload Dyymctbl
   'Unload mySeachForm '卸载查询窗体
   'Set myclsBal = Nothing
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  If DEBUG_FLAG = False Then On Error Resume Next
  Select Case Button.Key
      Case "ymsz"                                          '页面设置
          Dyymctbl.Show 1
      Case "yl"                                            '预 览
         Call bbyl(True)
      Case "dy"                                            '打 印
        Call bbyl(False)
      Case "cx"                                            '查 询
        Call IncFx(strTemItem)
        If Me.bSeach = True Then
            If DEBUG_FLAG = False Then Xt_Wait.Show
            Call FormInit
            Me.bSeach = False
            If DEBUG_FLAG = False Then Xt_Wait.Hide
        End If
      Case "bz"                                            '帮 助
        Call F1bz
      Case "fh"                                            '退 出
        Unload Me
   End Select
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整
  If DEBUG_FLAG = False Then On Error Resume Next
  Select Case Button.Key
      Case "bcgs"                                          '保存表格格式
        Call Bcwggs(CxbbGrid, GridCode)
      Case "hfmrgs"                                        '恢复默认格式
        Call Hfmrgs(CxbbGrid, GridCode)
      Case "szxsxm"                                        '设置显示项目
        Call Szxsxm(CxbbGrid, GridCode)
  End Select
End Sub
Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  If DEBUG_FLAG = False Then On Error Resume Next
  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) = 2                                    '报表行组织形式(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