日记帐.frm

用友u8财务源码,用visual basic开发

   dbsZJ.Rollback
End Sub

'*******************************************************************
'*函数说明: 外部账户积数余额处理                                     *
'*参    数: strAccID : 账户号                                       *
'*返回值  :                                                        *
'*******************************************************************
Private Sub SucWb(strAccID As String)
   Dim cMb     As Currency          '总余额
   Dim cMh     As Currency          '总积数
   Dim cMh_c   As Currency          '超定额积数
   Dim vDe     As Variant           '定额
   Dim sqlSum  As String
   Dim rsSum   As New UfRecordset
   Dim cDe     As Currency
   
   DeResult strAccID
   sqlSum = "SELECT * FROM FD_AccSum WHERE cAccID='" & strAccID & "' ORDER BY dbill_date"
   Set rsSum = dbsZJ.OpenRecordset(sqlSum, dbOpenDynaset)
   With rsSum
      If Not .EOF Then
         .Edit
'         !mb = !mb
         !Mh = !Mh - !Mh_Cad
         cMb = !Mb
         cMh = !Mh
         vDe = GetDe(!dbill_date)
         If IsEmpty(vDe) Then
            'cDe = cMb - CCur(vDe)
            cDe = 0
            !Mcde = IIf(cDe > 0, cDe, 0)
            !Mcdeh = !Mcde - !Mcdeh_Cad
            cMh_c = IIf(IsNull(!Mcdeh), 0, !Mcdeh)
         End If
         .Update
         .MoveNext
      End If
      While Not .EOF
         .Edit
         !Mb = !Mb + cMb
         !Mh = !Mh + !Mb + cMh - !Mh_Cad
         cMb = !Mb
         cMh = !Mh
         vDe = GetDe(!dbill_date)
         If IsEmpty(vDe) Then
            !Mcdeh = cMh_c
         Else
            cDe = cMb - CCur(vDe)
            !Mcde = IIf(cDe > 0, cDe, 0)
            !Mcdeh = !Mcde + cMh_c - !Mcdeh_Cad
            cMh_c = IIf(IsNull(!Mcdeh), 0, !Mcdeh)
         End If
         .Update
         .MoveNext
      Wend
   End With
   CloseRS rsSum

   '--- 对调整的积数进行处理
   Dim sqlExec As String
   
   sqlSum = "SELECT * FROM FD_AccSum WHERE cAccID = '" & strAccID & "' And mb_Cad <> 0 Or mcde_Cad <> 0"
   Set rsSum = dbsZJ.OpenRecordset(sqlSum, dbOpenSnapshot)
   While Not rsSum.EOF
      sqlExec = "Update FD_AccSum Set mh = mh + " & rsSum!mb_Cad & _
         ", mcdeh = mcdeh + " & rsSum!mcde_Cad & " Where cAccID = '" & _
         strAccID & "' And dbill_date >= '" & FormatDate(rsSum!dbill_date) & "'"
      dbsZJ.Execute sqlExec, dbFailOnError
      rsSum.MoveNext
   Wend
   CloseRS rsSum

End Sub

Private Function GetDe(dBill As Date) As Variant
   Dim i As Integer
   Dim nDe  As Currency
   Dim bDe  As Boolean
   
   For i = 1 To UBound(DeRst)
      If dBill >= DeRst(i).dDate Then
         If DeRst(i).bDe Then
            nDe = DeRst(i).nDe
            bDe = True
         Else
            bDe = False
         End If
      Else
         Exit For
      End If
   Next i
   If bDe Then GetDe = CCur(nDe)
End Function

'*******************************************************************
'*函数说明: 取出外部账户在凭证表中的数据添加到总账表中                *
'*参    数: strAccID : 账户号                                       *
'*          dOpenDate : 账户开户日期                                *
'*返回值  :                                                        *
'*******************************************************************
Private Sub DoWb(strAccID As String, dOpenDate As Date, xDate As Date)
   Dim sqlCale    As String
   Dim rsCale     As New UfRecordset
   Dim sqlItem    As String
   Dim rsItem     As New UfRecordset
   Dim sqlQc      As String
   Dim rsQc       As New UfRecordset
   Dim sqlSum     As String
   Dim bPropty    As Boolean
   Dim lngZhPrp   As Long
   Dim mQc        As Double
   Dim mQcjs      As Double

   sqlItem = "SELECT * FROM FD_AccSet WHERE cAccID = '" & strAccID & "'"
   Set rsItem = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
   With rsItem
   mQc = 0
   While Not .EOF
      lngZhPrp = GetZhDir(strAccID, !cCode)
      bPropty = GetKmPropty(!cCode)
      If IsNull(!cdeptcode) And IsNull(!cPersonCode) And IsNull(!cCusCode) And IsNull(!cSupCode) And IsNull(!cItem_id) And IsNull(!citem_class) Then
         mQc = mQc + lngZhPrp * GetKmQC(!cCode, bPropty)
      Else
         mQc = mQc + lngZhPrp * GetKmQC_Fz(!cCode, bPropty, !cdeptcode, !cPersonCode, !cCusCode, !cSupCode, !cItem_id, !citem_class)
      End If
      
      sqlQc = "SELECT Sum(md - mc) AS mMb FROM GL_accVouch WHERE ccode LIKE '" & !cCode & "%'"
      If Not IsNull(!cdeptcode) Then
         sqlQc = sqlQc & " And cdept_id LIKE '" & !cdeptcode & "%'"
      End If
      If Not IsNull(!cPersonCode) Then
         sqlQc = sqlQc & " And cperson_id = '" & !cPersonCode & "'"
      End If
      If Not IsNull(!cCusCode) Then
         sqlQc = sqlQc & " And ccus_id = '" & !cCusCode & "'"
      End If
      If Not IsNull(!cSupCode) Then
         sqlQc = sqlQc & " And csup_id = '" & !cSupCode & "'"
      End If
      If Not IsNull(!cItem_id) Then
         sqlQc = sqlQc & " And citem_id = '" & !cItem_id & "'"
      End If
      If Not IsNull(!citem_class) Then
         sqlQc = sqlQc & " And citem_class = '" & !citem_class & "'"
      End If
      sqlQc = sqlQc & " AND iflag IS NULL AND dbill_date <= '" & FormatDate(dOpenDate) & "' AND iperiod >= 1 AND iperiod <= 12"
      
      Set rsQc = dbsZJ.OpenRecordset(sqlQc, dbOpenSnapshot)
      mQc = mQc + IIf(IsNull(rsQc!mMb), 0, lngZhPrp * rsQc!mMb)
      
      sqlCale = "SELECT Sum(md - mc) AS mMb, dbill_date FROM GL_accVouch WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <=12"
      If Not IsNull(!cdeptcode) Then
         sqlCale = sqlCale & " And cdept_id LIKE '" & !cdeptcode & "%'"
      End If
      If Not IsNull(!cPersonCode) Then
         sqlCale = sqlCale & " And cperson_id = '" & !cPersonCode & "'"
      End If
      If Not IsNull(!cCusCode) Then
         sqlCale = sqlCale & " And ccus_id = '" & !cCusCode & "'"
      End If
      If Not IsNull(!cSupCode) Then
         sqlCale = sqlCale & " And csup_id = '" & !cSupCode & "'"
      End If
      If Not IsNull(!cItem_id) Then
         sqlCale = sqlCale & " And citem_id = '" & !cItem_id & "'"
      End If
      If Not IsNull(!citem_class) Then
         sqlCale = sqlCale & " And citem_class = '" & !citem_class & "'"
      End If
      sqlCale = sqlCale & " AND iflag IS NULL AND dbill_date > '" & FormatDate(dOpenDate) & "' AND dbill_date <= '" & FormatDate(xDate) & "' GROUP BY dbill_date"

      
'      sqlCale = "SELECT Sum(md-mc) AS mMb, dbill_date " & _
'         "FROM GL_accVouch " & _
'         "WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <=12 AND " & _
'         "IIf(" & IsNull(!cdeptcode) & ", True, cdept_id LIKE '" & !cdeptcode & "%') AND " & _
'         "IIf(" & IsNull(!cPersonCode) & ", True, cperson_id = '" & !cPersonCode & "') AND " & _
'         "IIf(" & IsNull(!cCusCode) & ", True, ccus_id = '" & !cCusCode & "') AND " & _
'         "IIf(" & IsNull(!cSupCode) & ", True, csup_id = '" & !cSupCode & "') AND " & _
'         "IIf(" & IsNull(!cItem_id) & ", True, citem_id = '" & !cItem_id & "') AND " & _
'         "IIf(" & IsNull(!citem_class) & ", True, citem_class = '" & !citem_class & "') " & _
'         "AND iflag IS NULL AND dbill_date > '" & FormatDate(dOpenDate) & "' AND dbill_date <= '" & _
'         FormatDate(xDate) & "' GROUP BY dbill_date"
      Set rsCale = dbsZJ.OpenRecordset(sqlCale, dbOpenSnapshot)
      With rsCale
         While Not .EOF
            sqlSum = "UPDATE FD_AccSum SET mb=mb+" & IIf(IsNull(!mMb), 0, lngZhPrp * !mMb) & _
               " WHERE cAccID='" & strAccID & "' AND dbill_date = '" & FormatDate(!dbill_date) & "'"
            dbsZJ.Execute sqlSum
            .MoveNext
         Wend
      End With
      rsItem.MoveNext
   Wend
   End With
   
   sqlQc = "SELECT mh FROM FD_AccDef WHERE cAccID='" & strAccID & "'"
   Set rsQc = dbsZJ.OpenRecordset(sqlQc, dbOpenSnapshot)
   mQcjs = rsQc!Mh
   sqlSum = "UPDATE FD_AccSum SET mb=" & mQc & ", mh=" & mQcjs & " WHERE cAccID='" & _
      strAccID & "' AND dbill_date='" & FormatDate(CDate(dOpenDate - 1)) & "'"
   dbsZJ.Execute sqlSum
   
End Sub

'*****%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函数说明: 外部账户在总账表中的数据追加到 dDate                      %
'%参    数: strAccID : 账户号                                       %
'%          dOpenDate : 账户开户日期                                %
'%返回值  :                                                        %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub TraceWb(strAccID As String, BillDate As Date)
   Dim i       As Long
   Dim sqlSum  As String
   
   With rsSumWb
      For i = 0 To dDate - BillDate
         .AddNew
         !cAccID = strAccID
         !dbill_date = BillDate + i
         .Update
      Next i
   End With
   sqlSum = "UPDATE FD_AccSum SET mb=0, mh=0, mcde=0, mcdeh=0 WHERE cAccID = '" & strAccID & "'"
   dbsZJ.Execute sqlSum
   
End Sub

Public Function GetQcye(strAccID As String, dOpenDate As Date) As Double
   Dim sqlSum As String
   Dim rsSum As New UfRecordset
   Dim sqlAccSet As String
   Dim rsAccSet As New UfRecordset
   Dim blnPrpty As Boolean
   Dim sqlVouch As String
   Dim rsVouch As New UfRecordset
   
   GetQcye = 0
   sqlAccSet = "SELECT * FROM FD_AccSet WHERE cAccID='" & strAccID & "'"
   Set rsAccSet = dbsZJ.OpenRecordset(sqlAccSet, dbOpenSnapshot)
   With rsAccSet
      If .EOF Then Exit Function
      While Not .EOF
         blnPrpty = GetKmPrpty(!cCode)
         If IsNull(!cdeptcode) And IsNull(!cPersonCode) And IsNull(!cCusCode) And IsNull(!cSupCode) And IsNull(!cItem_id) And IsNull(!citem_class) Then
            ' GL_accsum科目总账
            sqlSum = "SELECT IIf(cbegind_c='借',mb,-mb) AS dblMb FROM GL_accsum WHERE ccode='" & !cCode & "' AND iperiod=" & ZjAccInfo.GLBeginPeriod
            Set rsSum = dbsZJ.OpenRecordset(sqlSum, dbOpenSnapshot)
            If Not rsSum.EOF Then
               GetQcye = GetQcye + IIf(blnPrpty, rsSum!dblMb, -rsSum!dblMb)
            End If
            '从账务期初到资金建立此账户之间的累计发生额亦作为资金中此账户的期初
            If dOpenDate > CDate(ZjAccInfo.GLBeginPeriod & "-1") Then
               sqlVouch = "SELECT Sum(md-mc) AS dblMb FROM GL_accvouch WHERE ccode='" & !cCode & "' AND dbill_date Between '" & FormatDate(CDate(ZjAccInfo.GLBeginPeriod & "-1")) & _
                  "' AND '" & FormatDate(dOpenDate) & "' AND iperiod >= 1 And iperiod <=12 "
               Set rsVouch = dbsZJ.OpenRecordset(sqlVouch, dbOpenSnapshot)
               If Not IsNull(rsVouch!dblMb) Then
                  GetQcye = GetQcye + IIf(blnPrpty, rsVouch!dblMb, -rsVouch!dblMb)
               End If
            End If
         Else
            ' GL_accass辅助总账
            sqlSum = "SELECT IIf(cbegind_c='借',mb,-mb) AS dblMb FROM GL_accass WHERE ccode='" & !cCode & "' AND iperiod=" & ZjAccInfo.GLBeginPeriod & _
               " AND IIf(IsNull(cdept_id),0=0,cdept_id='" & !cdeptcode & "') AND IIf(IsNull(cperson_id),0=0,cperson_id='" & !cPersonCode & "') AND IIf(IsNull(ccus_id),0=0,ccus_id='" & _
                  !cCusCode & "') AND IIf(IsNull(csup_id),0=0,csup_id='" & !cSupCode & "') AND IIf(IsNull(citem_class),0=0,citem_class='" & !citem_class & "') AND IIf(IsNull(citem_id),0=0,citem_id='" & !cItem_id & "')"
            Set rsSum = dbsZJ.OpenRecordset(sqlSum, dbOpenSnapshot)
            If Not rsSum.EOF Then
               GetQcye = GetQcye + IIf(blnPrpty, rsSum!dblMb, -rsSum!dblMb)
            End If
            '从账务期初到资金建立此账户之间的累计发生额亦作为资金中此账户的期初
            If dOpenDate > CDate(ZjAccInfo.GLBeginPeriod & "-1") Then
               sqlVouch = "SELECT Sum(md-mc) AS dblMb FROM GL_accvouch WHERE ccode='" & !cCode & "' AND iperiod >= 1 And iperiod <=12 AND dbill_date Between '" & FormatDate(CDate(ZjAccInfo.GLBeginPeriod & "-1")) & _
                  "' AND '" & FormatDate(dOpenDate) & "' AND IIf(IsNull(cdept_id),0=0,cdept_id='" & !cdeptcode & "') AND IIf(IsNull(cperson_id),0=0,cperson_id='" & !cPersonCode & "') AND IIf(IsNull(ccus_id),0=0,ccus_id='" & _
                  !cCusCode & "') AND IIf(IsNull(csup_id),0=0,csup_id='" & !cSupCode & "') AND IIf(IsNull(citem_class),0=0,citem_class='" & !citem_class & "') AND IIf(IsNull(citem_id),0=0,citem_id='" & !cItem_id & "')"
               Set rsVouch = dbsZJ.OpenRecordset(sqlVouch, dbOpenSnapshot)
               If Not IsNull(rsVouch!dblMb) Then
                  GetQcye = GetQcye + IIf(blnPrpty, rsVouch!dblMb, -rsVouch!dblMb)
               End If
            End If
         End If
         .MoveNext
      Wend
   End With
   
End Function

Public Function GetKmPrpty(mCode As String) As Boolean
   Dim sqlPrpty As String
   Dim rsPrpty As New UfRecordset
   sqlPrpty = "SELECT bProperty FROM code WHERE ccode='" & mCode & "'"
   Set rsPrpty = dbsZJ.OpenRecordset(sqlPrpty, dbOpenSnapshot)
   If Not rsPrpty.EOF Then
      GetKmPrpty = rsPrpty!bProperty
   End If
   
End Function

Private Sub TraceToNow(strAccID As String)
   Dim sqlAccSum As String
   Dim rsAccSum As New UfRecordset
   Dim dBillDate As Date
   Dim curMb As Currency
   Dim curMh As Currency
   Dim i As Integer
   
   sqlAccSum = "SELECT * FROM FD_AccSum WHERE cAccID='" & strAccID & _
               "' ORDER BY dbill_date DESC"
   Set rsAccSum = dbsZJ.OpenRecordset(sqlAccSum, dbOpenDynaset)
   With rsAccSum
      dBillDate = !dbill_date
      curMb = !Mb
      curMh = !Mh
      For i = 1 To dDate - dBillDate
         .AddNew
         !cAccID = strAccID
         !dbill_date = dBillDate + i
         !Mb = curMb
         !Mh = curMh + curMb * i
         .Update