frmpingheng.frm

财务管理信息系统

            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column07 
         DataField       =   "期末贷方"
         Caption         =   "期末贷方"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            ColumnWidth     =   929.764
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   824.882
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   900.284
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   945.071
         EndProperty
         BeginProperty Column04 
            ColumnWidth     =   1170.142
         EndProperty
         BeginProperty Column05 
            ColumnWidth     =   1214.929
         EndProperty
         BeginProperty Column06 
            ColumnWidth     =   854.929
         EndProperty
         BeginProperty Column07 
            ColumnWidth     =   840.189
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmPingHeng"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub form_load()
    Dim db As New DataBases
    Dim strSQL As String
    strSQL = "select 科目代码,科目名称,(case"
    strSQL = strSQL + " when 余额方向='借方' then 期初余额 else 0 end -"
    strSQL = strSQL + " 累计借方) as 期初借方,(case when 余额方向='贷方'"
    strSQL = strSQL + " then 期初余额 else 0 end - 累计贷方) as 期初贷方,"
    strSQL = strSQL + "累计借方 as 本期发生借方,累计贷方 as 本期发生贷方,"
    strSQL = strSQL + "case when 余额方向='借方' then 期初余额 else 0 end as "
    strSQL = strSQL + "期末借方,case when 余额方向='贷方' then 期初余额 else 0"
    strSQL = strSQL + " end as 期末贷方 from 帐簿初始化表 where 累计借方<>0 or"
    strSQL = strSQL + " 累计贷方<>0 or 期初余额<>0"
    Set Adodc1.Recordset = db.RunSelectSQL(strSQL)
    fgBottom.Rows = 1
    fgBottom.Cols = 8
    fgBottom.TextMatrix(0, 1) = "是否平衡"
    fgBottom.TextMatrix(0, 2) = "期初借方合计"
    fgBottom.TextMatrix(0, 3) = "期初贷方合计"
    fgBottom.TextMatrix(0, 4) = "本期借方合计"
    fgBottom.TextMatrix(0, 5) = "本期贷方合计"
    fgBottom.TextMatrix(0, 6) = "期末借方合计"
    fgBottom.TextMatrix(0, 7) = "期末贷方合计"
    CalPingHeng (0)
End Sub

' 计算是否平衡并显示出计算结果
' nStatus 0 初始化帐簿时计算
' 1 正式使用后凭证的计算
Public Function CalPingHeng(ByVal iStatus As Integer) As Boolean
    Dim bResult As Boolean
    ' 根据不同的状态计算平衡情况
    Dim strSQL As String
    ' 初始化帐簿的试算平衡,需要根据初始化的信息反算期初
    Dim db As New DataBases
    If iStatus = 0 Then
        strSQL = "select 科目代码, 科目名称,"
        strSQL = strSQL + "(case when 余额方向='借方' then 期初余额 "
        strSQL = strSQL + " else 0 end - 累计借方) as 期初借方,"
        strSQL = strSQL + "(case when 余额方向='贷方' then 期初余额"
        strSQL = strSQL + "  else 0 end - 累计贷方) as 期初贷方,"
        strSQL = strSQL + "累计借方 as 本期发生借方,累计贷方 as 本期发生贷方,"
        strSQL = strSQL + "case when 余额方向='借方' then 期初余额 "
        strSQL = strSQL + "else 0 end as 期末借方,"
        strSQL = strSQL + "case when 余额方向='贷方' then 期初余额 "
        strSQL = strSQL + " else 0 end as 期末贷方 "
        strSQL = strSQL + " from 帐簿初始化表 "
        strSQL = strSQL + " where 累计借方<>0 or 累计贷方<>0 or 期初余额<>0"
        Set grdDataGrid.DataSource = db.RunSelectSQL(strSQL)
        ' 计算合计金额,用于判断是否平衡
        strSQL = "select "
        strSQL = strSQL + "sum(case when 余额方向='借方' "
        strSQL = strSQL + " then 期初余额 else 0 end-累计借方) as 期初借方合计,"
        strSQL = strSQL + "sum(case when 余额方向='贷方' "
        strSQL = strSQL + " then 期初余额 else 0 end-累计贷方) as 期初贷方合计,"
        strSQL = strSQL + "sum(累计借方) as 本期借方合计,sum(累计贷方) "
        strSQL = strSQL + "as 本期贷方合计,"
        strSQL = strSQL + "sum(case when 余额方向='借方' then  "
        strSQL = strSQL + "期初余额 else 0 end) as 期末借方合计,"
        strSQL = strSQL + "sum(case when 余额方向='贷方' then  "
        strSQL = strSQL + " 期初余额 else 0 end) as 期末贷方合计"
        strSQL = strSQL + " from 帐簿初始化表 "
        strSQL = strSQL + " where 累计借方<>0 or 累计贷方<>0 or 期初余额<>0"
        Dim rs As Recordset
        Set rs = db.RunSelectSQL(strSQL)
        bResult = AddToDataTable(rs)
    Else
        strSQL = "select a.科目代码, b.科目名称,"
        strSQL = strSQL + "(case when a.余额方向='借方' "
        strSQL = strSQL + " then 期初余额 else 0 end ) as 期初借方,"
        strSQL = strSQL + "(case when a.余额方向='贷方' "
        strSQL = strSQL + " then 期初余额 else 0 end) as 期初贷方,"
        strSQL = strSQL + "本期借方合计 as 本期发生借方, 本期贷方合计 "
        strSQL = strSQL + "as 本期发生贷方,"
        strSQL = strSQL + "case when a.余额方向='借方' then 余额 else 0 end "
        strSQL = strSQL + "as 期末借方,"
        strSQL = strSQL + "case when a.余额方向='贷方' then 余额 else 0 end "
        strSQL = strSQL + "as 期末贷方"
        strSQL = strSQL + " from 本期汇总账簿 as a, 科目表 as b  "
        strSQL = strSQL + " where a.科目代码 = b.科目代码 and (本期借方合计<> 0"
        strSQL = strSQL + " or 本期贷方合计<>0 or 期初余额<>0 or 余额<>0)"
        Set grdDataGrid.DataSource = db.RunSelectSQL(strSQL)
        strSQL = "select "
        strSQL = strSQL + "sum(case when 余额方向='借方' then 期初余额 else 0 end)"
        strSQL = strSQL + " as 期初借方合计,"
        strSQL = strSQL + "sum(case when 余额方向='贷方' then 期初余额 else 0 end)"
        strSQL = strSQL + " as 期初贷方合计,"
        strSQL = strSQL + "sum(本期借方合计) as 本期借方合计,sum(本期贷方合计) "
        strSQL = strSQL + "as 本期贷方合计,"
        strSQL = strSQL + "sum(case when 余额方向='借方' then 余额 else 0 end) "
        strSQL = strSQL + "as 期末借方合计,"
        strSQL = strSQL + "sum(case when 余额方向='贷方' then 余额 else 0 end) "
        strSQL = strSQL + "as 期末贷方合计"
        strSQL = strSQL + " from 本期汇总账簿 "
        strSQL = strSQL + " where 本期借方合计<> 0 or 本期贷方合计<>0 or "
        strSQL = strSQL + "期初余额<>0 or 余额<>0"
        Set rs = db.RunSelectSQL(strSQL)
        bResult = AddToDataTable(rs)
'        Set Me.fgBottom.DataSource = rs
    End If
    CalPingHeng = bResult
End Function

Private Function AddToDataTable(ByRef rs As Recordset) As Boolean
    Dim bResult As Boolean
    '清空数据表的内容
    Dim iRow As Integer
    fgBottom.Rows = 2
    iRow = fgBottom.Rows - 1
    '获取一行数据
    fgBottom.TextMatrix(iRow, 2) = SetText(rs("期初借方合计"))
    fgBottom.TextMatrix(iRow, 3) = SetText(rs("期初贷方合计"))
    fgBottom.TextMatrix(iRow, 4) = SetText(rs("本期借方合计"))
    fgBottom.TextMatrix(iRow, 5) = SetText(rs("本期贷方合计"))
    fgBottom.TextMatrix(iRow, 6) = SetText(rs("期末借方合计"))
    fgBottom.TextMatrix(iRow, 7) = SetText(rs("期末贷方合计"))
    '判断是否平衡
    If SetText(rs("期初借方合计")) _
        <> SetText(rs("期初贷方合计")) Or _
        SetText(rs("本期借方合计")) _
        <> SetText(rs("本期贷方合计")) Or _
        SetText(rs("期末借方合计")) _
        <> SetText(rs("期末贷方合计")) Then
            fgBottom.TextMatrix(iRow, 1) = "不平衡"
            bResult = False
    Else
        fgBottom.TextMatrix(iRow, 1) = "平衡"
        bResult = True
    End If
    AddToDataTable = bResult
End Function

Private Function SetText(ByVal obj As Object) As String
    If IsNull(obj) Then
        SetText = ""
    Else
        SetText = obj
    End If
End Function