银行动态表.frm

财务信息管理系统,适合做毕业论文的人使用

'*返回值  :                                                          *
'*********************************************************************
Public Sub mCale()
    '----设置互斥
    m_bExclude = True
   
   Dim rsItem As New UfRecordset
   Dim rsCale As New UfRecordset
   Dim sqlItem As String
   Dim sqlCale As String
   Dim strTotal As String
   Dim rsProperty As New UfRecordset
   Dim bProperty As Boolean
   Dim sqlQc As String
   Dim rsQc As New UfRecordset
   Dim mQc As Double
   Dim cExch As String
   Dim dblHl As Variant
   Dim dblA As Variant
   Dim dblB As Variant
   Dim dblC As Variant
   Dim dblD As Variant
   Dim dblE As Variant
   Dim iTotal As Boolean
   Dim todayMb As Double
   Dim preMb As Double
   Dim CurMd As Double
   Dim curMc As Double
   Dim mInTemp As Long
   Dim mOut As Long
   Dim iX As Integer
   Dim i As Long
   Dim sqlX As String
   Dim rsX As New UfRecordset
   Dim flxAccID As String
   Dim RsAccDef As UfRecordset
                  
   sqlItem = "SELECT * FROM FD_Items WHERE iitems_id=2 ORDER BY citem_id"
   Set rsItem = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
   StatusBar1.Visible = True
   ProBar1.Visible = True
   Form_Resize
   If Not rsItem.EOF Then
      rsItem.MoveLast
      ProBar1.Max = rsItem.RecordCount
      ProBar1.Value = 0
      ProBar1.Min = 0
      rsItem.MoveFirst
      DoUnload True
   End If
   With rsItem
      While Not .EOF
         ChangeStatus "项目：" & !cItem_Name, 1
         preGrade = !iGrade
         If !bend Then   ' 末级，计算
            If !bSource Then   '从科目取数
               cExch = ZjAccInfo.zjStandExch
               dblHl = 1
               flxAccID = ""
               Cal_YhdtKm !iItem_id
               With YhdtInfo
                  todayMb = .todayMb
                  CurMd = .CurMd
                  curMc = .curMc
                  preMb = .preMb
                  mInTemp = .mInTemp
                  mOut = .mOut
                  dblE = .mJsz
               End With
               dblA = todayMb
               dblB = CurMd
               dblC = curMc
               dblD = preMb
               For i = 1 To preGrade
                  preDayYe(i) = preDayYe(i) + preMb
                  toDaySr(i) = toDaySr(i) + CurMd
                  toDayZc(i) = toDayZc(i) + curMc
                  toDayJsz(i) = toDayJsz(i) + CurMd - curMc
                  toDayYe(i) = toDayYe(i) + todayMb
                  toDayBsr(i) = toDayBsr(i) + mInTemp
                  toDayBzc(i) = toDayBzc(i) + mOut
               Next i
            Else                 '从账户取数
'               sqlX = "SELECT cAccID FROM FD_AccDef WHERE cAccID IN (SELECT " & _
                  "ccode FROM FD_Itemss WHERE iitem_id=" & !iItem_id & ")" 'Cuidong 2000/08/25
               sqlX = "SELECT cAccID, cAccBank FROM FD_AccDef WHERE cAccID IN (SELECT " & _
                  "ccode FROM FD_Itemss WHERE iitem_id=" & !iItem_id & ")"
               Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
               flxAccID = ""
               If Not rsX.EOF Then
                  rsX.MoveLast
                  If rsX.RecordCount = 1 Then
                     flxAccID = rsX!cAccID
                  End If
               End If
               
               '判断此项目下包含内部账户或外部账户或都有
               iX = GetZhStyle(!iItem_id)
               
               '取出币别和汇率
               cExch = GetExch(!iItem_id)
               If cExch <> "" Then
                  dblHl = GetCurHl(cExch, zjLogInfo.curDate)
                  If dblHl = 0 Then
                     MsgBox "币别" & cExch & "未设置汇率！", vbInformation, zjGl_Name
                     dblHl = ""
                  End If
               Else
                  dblHl = ""
               End If
               dblA = 0: dblB = 0: dblC = 0: dblD = 0: dblE = 0
               '第一步：从资金账户取数
               If iX = 1 Or iX = 3 Then
                  Cal_Yhdt !iItem_id
                  With YhdtInfo
                     todayMb = .todayMb
                     CurMd = .CurMd
                     curMc = .curMc
                     preMb = .preMb
                     mInTemp = .mInTemp
                     mOut = .mOut
                  End With
                  If dblHl = "" Then
                     dblA = "": dblB = "": dblC = "": dblD = "": dblE = ""
                  Else
                     dblA = todayMb / dblHl
                     dblB = CurMd / dblHl
                     dblC = curMc / dblHl
                     dblD = preMb / dblHl
                     dblE = YhdtInfo.mJsz / dblHl
                  End If
                  
                  For i = 1 To preGrade
                     preDayYe(i) = preDayYe(i) + preMb
                     toDaySr(i) = toDaySr(i) + CurMd
                     toDayZc(i) = toDayZc(i) + curMc
                     toDayJsz(i) = toDayJsz(i) + (CurMd - curMc)
                     toDayYe(i) = toDayYe(i) + todayMb
                     toDayBsr(i) = toDayBsr(i) + mInTemp
                     toDayBzc(i) = toDayBzc(i) + mOut
                  Next i
               End If
               '第二步：从账务账户取数
               If iX = 2 Or iX = 3 Then
                  Cal_YhdtZh !iItem_id
                  With YhdtInfo
                     todayMb = .todayMb
                     CurMd = .CurMd
                     curMc = .curMc
                     preMb = .preMb
                     mInTemp = .mInTemp
                     mOut = .mOut
                  End With
                  If dblHl = "" Then
                     dblA = "": dblB = "": dblC = "": dblD = "": dblE = ""
                  Else
                     dblA = dblA + todayMb / dblHl
                     dblB = dblB + CurMd / dblHl
                     dblC = dblC + curMc / dblHl
                     dblD = dblD + preMb / dblHl
                     dblE = dblE + YhdtInfo.mJsz / dblHl
                  End If
                  
                  For i = 1 To preGrade
                     preDayYe(i) = preDayYe(i) + preMb
                     toDaySr(i) = toDaySr(i) + CurMd
                     toDayZc(i) = toDayZc(i) + curMc
                     toDayJsz(i) = toDayJsz(i) + (CurMd - curMc)
                     toDayYe(i) = toDayYe(i) + todayMb
                     toDayBsr(i) = toDayBsr(i) + mInTemp
                     toDayBzc(i) = toDayBzc(i) + mOut
                  Next i
               End If
            End If
            If dblHl = "" Then
               dblA = 0: dblB = 0: dblC = 0: dblD = 0: dblE = 0
            End If
'           UfGridADO1.AddItem flxAccID & vbTab & Space((preGrade - 1) * 3) & !cItem_Name & _
                               vbTab & cExch & vbTab & dblHl & vbTab & FormatCur(dblD) & vbTab & FormatCur(preDayYe(preGrade)) & _
                               vbTab & IIf(dblB = 0, "", FormatCur(dblB)) & vbTab & IIf(toDaySr(preGrade) = 0, "", FormatCur(toDaySr(preGrade))) & vbTab & IIf(toDayBsr(preGrade) = 0, "", toDayBsr(preGrade)) & _
                               vbTab & IIf(dblC = 0, "", FormatCur(dblC)) & vbTab & IIf(toDayZc(preGrade) = 0, "", FormatCur(toDayZc(preGrade))) & vbTab & IIf(toDayBzc(preGrade) = 0, "", toDayBzc(preGrade)) & _
                               vbTab & FormatCur(dblA) & vbTab & FormatCur(toDayYe(preGrade)) & vbTab & IIf(dblE = 0, "", FormatCur(dblE)) & vbTab & _
                               IIf(toDayJsz(preGrade) = 0, "", FormatCur(toDayJsz(preGrade)))
'            Set RsAccDef = dbsZJ.OpenRecordset("SELECT * FROM FD_AccDef WHERE cAccID = '" & flxAccID & "'") 'Cuidong 2000/08/25
'            If Not (RsAccDef.EOF Or RsAccDef.BOF) Then                                                      'Cuidong 2000/08/25
'               UfGridADO1.AddItem flxAccID & vbTab & Space((preGrade - 1) * 3) & IIf(IsNull(RsAccDef.Fields!cAccBank), "", RsAccDef.Fields!cAccBank) & _
                  vbTab & cExch & vbTab & dblHl & vbTab & FormatCur(dblD) & vbTab & FormatCur(preDayYe(preGrade)) & _
                  vbTab & IIf(dblB = 0, "", FormatCur(dblB)) & vbTab & IIf(toDaySr(preGrade) = 0, "", FormatCur(toDaySr(preGrade))) & vbTab & IIf(toDayBsr(preGrade) = 0, "", toDayBsr(preGrade)) & _
                  vbTab & IIf(dblC = 0, "", FormatCur(dblC)) & vbTab & IIf(toDayZc(preGrade) = 0, "", FormatCur(toDayZc(preGrade))) & vbTab & IIf(toDayBzc(preGrade) = 0, "", toDayBzc(preGrade)) & _
                  vbTab & FormatCur(dblA) & vbTab & FormatCur(toDayYe(preGrade)) & vbTab & IIf(dblE = 0, "", FormatCur(dblE)) & vbTab & _
                  IIf(toDayJsz(preGrade) = 0, "", FormatCur(toDayJsz(preGrade)))           'Cuidong 2000/08/25
               UfGridado1.AddItem flxAccID & vbTab & Space((preGrade - 1) * 3) & IIf(IsNull(!cItem_Name), "", !cItem_Name) & _
                  vbTab & cExch & vbTab & dblHl & vbTab & FormatCur(dblD) & vbTab & FormatCur(preDayYe(preGrade)) & _
                  vbTab & IIf(dblB = 0, "", FormatCur(dblB)) & vbTab & IIf(toDaySr(preGrade) = 0, "", FormatCur(toDaySr(preGrade))) & vbTab & IIf(toDayBsr(preGrade) = 0, "", toDayBsr(preGrade)) & _
                  vbTab & IIf(dblC = 0, "", FormatCur(dblC)) & vbTab & IIf(toDayZc(preGrade) = 0, "", FormatCur(toDayZc(preGrade))) & vbTab & IIf(toDayBzc(preGrade) = 0, "", toDayBzc(preGrade)) & _
                  vbTab & FormatCur(dblA) & vbTab & FormatCur(toDayYe(preGrade)) & vbTab & IIf(dblE = 0, "", FormatCur(dblE)) & vbTab & _
                  IIf(toDayJsz(preGrade) = 0, "", FormatCur(toDayJsz(preGrade)))

'            End If           'Cuidong 2000/08/25
            'RsAccDef.oClose  'Cuidong 2000/08/25
            
            If preGrade <> 1 Then MakeZero preGrade
         Else              ' 非末级
            
            UfGridado1.AddItem vbTab & Space((preGrade - 1) * 3) & !cItem_Name
         End If
         .MoveNext
         If .EOF Then
            iTotal = True
         Else
            If !iGrade = 1 Then iTotal = True
         End If
         If iTotal Then
            For i = preGrade - 1 To 2 Step -1
               strTotal = "小计:"
               With UfGridado1
                  .AddItem vbTab & Space(i * 3) & strTotal & vbTab & "" & vbTab & "" & _
                     vbTab & "" & vbTab & FormatCur(preDayYe(i)) & vbTab & "" & vbTab & IIf(toDaySr(i) = 0, "", FormatCur(toDaySr(i))) & _
                     vbTab & IIf(toDayBsr(i) = 0, "", toDayBsr(i)) & vbTab & "" & vbTab & IIf(toDayZc(i) = 0, "", FormatCur(toDayZc(i))) & _
                     vbTab & IIf(toDayBzc(i) = 0, "", toDayBzc(i)) & vbTab & "" & vbTab & FormatCur(toDayYe(i)) & vbTab & _
                     "" & vbTab & IIf(toDayJsz(i) = 0, "", FormatCur(toDayJsz(i)))
               End With
               MakeZero i
            Next i
            strTotal = "合计:"
            With UfGridado1
               .AddItem vbTab & Space(3) & strTotal & vbTab & "" & vbTab & "" & _
                  vbTab & "" & vbTab & FormatCur(preDayYe(1)) & vbTab & "" & vbTab & IIf(toDaySr(1) = 0, "", FormatCur(toDaySr(1))) & _
                  vbTab & IIf(toDayBsr(1) = 0, "", toDayBsr(1)) & vbTab & "" & vbTab & IIf(toDayZc(1) = 0, "", FormatCur(toDayZc(1))) & _
                  vbTab & IIf(toDayBzc(1) = 0, "", toDayBzc(1)) & vbTab & "" & vbTab & FormatCur(toDayYe(1)) & vbTab & _
                  "" & vbTab & IIf(toDayJsz(1) = 0, "", FormatCur(toDayJsz(1)))
            End With
            MakeZero 1
            iTotal = False
         Else
            If !iGrade < preGrade Then
               strTotal = "小计:"
               With UfGridado1
                  .AddItem vbTab & Space((preGrade - 1) * 3) & strTotal & vbTab & "" & vbTab & "" & _
                     vbTab & "" & vbTab & FormatCur(preDayYe(preGrade - 1)) & vbTab & "" & vbTab & IIf(toDaySr(preGrade - 1) = 0, "", FormatCur(toDaySr(preGrade - 1))) & _
                     vbTab & IIf(toDayBsr(preGrade - 1) = 0, "", toDayBsr(preGrade - 1)) & vbTab & "" & vbTab & IIf(toDayZc(preGrade - 1) = 0, "", FormatCur(toDayZc(preGrade - 1))) & _
                     vbTab & IIf(toDayBzc(preGrade - 1) = 0, "", toDayBzc(preGrade - 1)) & vbTab & "" & vbTab & FormatCur(toDayYe(preGrade - 1)) & vbTab & _
                     "" & vbTab & IIf(toDayJsz(preGrade - 1) = 0, "", FormatCur(toDayJsz(preGrade - 1)))
               End With
               MakeZero preGrade - 1
            End If
         End If
      Wend
   End With
   DoUnload False
   StatusBar1.Visible = False
   ProBar1.Visible = False
   UfGridado1.Height = UfGridado1.Height + StatusBar1.Height
   With UfGridado1
      .Row = .Rows - 1
      .Col = 0
   End With
   
    '----设置互斥
    m_bExclude = False

End Sub

'********************************************************************
'*函数说明: 计算资金账户                                              *
'*参    数: iItem_id : 项目编号                                       *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub Cal_Yhdt(iItem_id As String)
   Dim sqlCal As String
   Dim rsCal As New UfRecordset
   Dim sqlItemss As String
   Dim rsItemss As New UfRecordset
   Dim cExch As String
   Dim dblHl As Double
   Dim m1 As Double
   Dim m2 As Double
   Dim m3 As Double
   Dim M4 As Double
   Dim M5 As Double
   Dim cSearchDate As String
   Dim cBYear  As String
   Dim oOption As COption
   
   Set oOption = New COption
   oOption.Init dbsZJ
   cBYear = FormatDate(oOption.Option1)
   cSearchDate = FormatDate(dSearchDate)
   
   sqlItemss = "SELECT ccode FROM FD_Itemss WHERE iitem_id = " & iItem_id & _
      " AND ccode IN (SELECT cAccID FROM FD_AccDef WHERE iDataSrc=0)"
   Set rsItemss = dbsZJ.OpenRecordset(sqlItemss, dbOpenSnapshot)
   While Not rsItemss.EOF
      sqlCal = "SELECT Sum(mmoney) AS todayMb, " & _
         "Sum(Case When dbill_date = '" & cSearchDate & "' Then mmoney Else 0 End) AS curMd, " & _
         "0 AS curMc, " & _
         "Sum(Case When dbill_date = '" & cSearchDate & "' Then 1 Else 0 End) AS mInTemp, " & _
         "0 AS mOut " & _