ledgermodule.bas

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

            If rs2.EOF And rs2.BOF Then '如果为空,表示没有初始,出错
                CurLastBalanceMoney = 0
                CurLastBalanceQuantity = 0
            Else
                rs2.MoveLast
                CurLastBalanceMoney = rs2!FBalanceMoney
                CurLastBalanceQuantity = rs2!FBalanceQuantity
            End If
            '计算结存数量
            '加权平均单价=(期初结存金额+本期收入金额-本期非销售付出金额)/(期初结存数量+本期收入数量-本期非销售付出数量)
            tempQuantity = CurLastBalanceQuantity + rs!SuminQuantity + rs!SumDiaoboInQuantity - rs!SumOutQuantity - rs!SumDiaoboOutQuantity
            tempPrice = 0
            If (CurLastBalanceQuantity + rs!SuminQuantity) = 0 Then
                Do While tempPrice = 0
                    tempPrice = Val(InputBox("由于该商品没有期初结存单价,本期没有购进,需要输入结存单价", sHouseCode & "库房,编号 " & sWarescode & "需要输入结存单价", 0))
                Loop
            Else
            
                tempPrice = (CurLastBalanceMoney + rs!SuminMoney) / (CurLastBalanceQuantity + rs!SuminQuantity)
                
            End If
            tempMoney = tempQuantity * tempPrice
            '四舍五入结存金额
            tempMoney = Format(tempMoney, "0.00")
        Else
            rs2.Filter = "FFlag= " & PREV_MONTH_CLOSE & " or  FFlag = " & PREV_YEAR_CLOSE & " or  FFlag = " & THIS_MONTH_SUM   'THIS_MONTH_SUM,PREV_YEAR_CLOSE,PREV_MONTH_CLOSE
            If rs2.EOF And rs2.BOF Then
                tempMoney = 0
                tempQuantity = 0
                tempPrice = 0
            Else
                rs2.MoveLast
                tempMoney = rs2!FBalanceMoney
                tempQuantity = rs2!FBalanceQuantity
                tempPrice = rs2!FbalancePrice
            End If
            
        End If
        
        rs2.Filter = 0
        If nSumType = 5 Then ' 上年结转
           sMonth = "01"
           sYear = Format(Val(sYear) + 1)
           sDate = sYear & "/" & sMonth & "/01"
        End If
        If nSumType = 4 Then
            sDate = GetCloseDay(True, m_gnYear, m_gbyMonth)
            sMonth = Format(Val(sMonth) + 1)
        End If
        rs2.AddNew
        rs2!FYear = Val(sYear)
        rs2!FMonth = Val(sMonth)
        rs2!FAbstract = strAbstract
        rs2!FFlag = nFlag
        rs2!FDate = sDate
        rs2!Fhousecode = sHouseCode
        rs2!FWaresCode = sWarescode
        If nSumType < 4 Then
            If Not IsNull(rs!SuminQuantity) Then
                rs2!FInQuantity = rs!SuminQuantity
                rs2!FInMoney = rs!SuminMoney
            End If
            If Not IsNull(rs!SumOutQuantity) Then
                rs2!FOutQuantity = rs!SumOutQuantity
                rs2!FOutMoney = rs!SumOutMoney
            End If
            If Not IsNull(rs!SumDiaoboInQuantity) Then
                rs2!FDiaoboInQuantity = rs!SumDiaoboInQuantity
                rs2!FDiaoboINmoney = rs!SumDiaoboinMoney
            End If
            If Not IsNull(rs!SumDiaoboOutQuantity) Then
                rs2!FDiaoboOutQuantity = rs!SumDiaoboOutQuantity
                rs2!FDiaoboOutMoney = rs!SumDiaoboOutMoney
            End If
        End If
        If nSumType = 5 Or nSumType = 4 Then
            rs2!FBalanceQuantity = tempQuantity
            rs2!FbalancePrice = tempPrice
            rs2!FBalanceMoney = tempMoney
        End If
        If nSumType = 1 Then '本月合计 写销售成本、销售差价 上月结转
            rs2!FBalanceQuantity = tempQuantity
            rs2!FbalancePrice = tempPrice
            rs2!FBalanceMoney = tempMoney
            rs2!FSellbaseMoney = CurLastBalanceMoney + rs!SuminMoney + rs!SumDiaoboinMoney - tempMoney - rs!SumDiaoboOutMoney
            If Not m_gbSellMoney Then rs2!FOutMoney = rs2!FSellbaseMoney
            rs2!FSellChaJiaMoney = rs!SumOutMoney - rs2!FSellbaseMoney
        End If
        rs2.Update
        
        
        
   Case MOVE_AVER_MODE '2
        rs2.Filter = strSumFilter & " and FFlag<13 "
        tempQuantity = rs2!FBalanceQuantity
        tempMoney = rs2!FBalanceMoney
        tempPrice = rs2!FbalancePrice
         If nSumType = 4 Then '上月结转
           sMonth = Format(Val(sMonth) + 1)
           sDate = sYear & "/" & sMonth & "/01"
        ElseIf nSumType = 5 Then ' 上年结转
           sMonth = "01"
           sYear = Format(Val(sYear) + 1)
           sDate = sYear & "/" & sMonth & "/01"
        End If
        rs2.AddNew
        rs2!FYear = Val(sYear)
        rs2!FMonth = Val(sMonth)
        rs2!FAbstract = strAbstract
        rs2!FFlag = nFlag
        rs2!FDate = sDate
        rs2!Fhousecode = sHouseCode
        rs2!FWaresCode = sWarescode
        If nSumType < 4 Then
            If Not IsNull(rs!SuminQuantity) Then
                rs2!FInQuantity = rs!SuminQuantity
                rs2!FInMoney = rs!SuminMoney
            End If
            If Not IsNull(rs!SumOutQuantity) Then
                rs2!FOutQuantity = rs!SumOutQuantity
                rs2!FOutMoney = rs!SumOutMoney
            End If
            If Not IsNull(rs!SumDiaoboInQuantity) Then
                rs2!FDiaoboInQuantity = rs!SumDiaoboInQuantity
                rs2!FDiaoboINmoney = rs!SumDiaoboinMoney
            End If
            If Not IsNull(rs!SumDiaoboOutQuantity) Then
                rs2!FDiaoboOutQuantity = rs!SumDiaoboOutQuantity
                rs2!FDiaoboOutMoney = rs!SumDiaoboOutMoney
            End If
        End If
        rs2!FBalanceMoney = tempMoney
        rs2!FBalanceQuantity = tempQuantity
        rs2!FbalancePrice = tempPrice
        rs2.Update
   End Select
   rs2.Close
   
   
End If

KeepRecordMonth = True
Exit Function
KeepErr:
    KeepRecordMonth = False
End Function
'当月结时计算
Function CollectHouse(ByVal sHouseCode As String, ByVal nFlag As Integer, ByVal sAbstract As String) As Boolean

Dim SumMoney(5) As Currency
Dim i As Integer
Dim strSQL As String
'先写本月合计
On Error GoTo CollectErr


Dim SumMoneyRs As ADODB.Recordset
Set SumMoneyRs = New ADODB.Recordset


    strSQL = " SELECT Sum(ledger.FInMoney) AS SuminMoney,  Sum(ledger.FDiaoBoInMoney) AS SumDiaoboInmoney,Sum(ledger.FOutMoney) AS SumOutMoney, Sum(ledger.FDiaoBoOutMoney) AS SumDiaoBoOutMoney " & _
             " From ledger Where FhouseCode ='" & sHouseCode & "' and   FYear = " & m_gnYear & " and Fmonth = " & m_gbyMonth & " And FFlag =  " & nFlag
    SumMoneyRs.Open strSQL, m_gDBCnn, adOpenStatic, adLockReadOnly
    With SumMoneyRs
        If .EOF And .BOF Then
            For i = 0 To 3
                SumMoney(i) = 0#
            Next i
        Else
            If IsNull(.Fields(0).Value) Then
                For i = 0 To 3
                    SumMoney(i) = 0#
                Next i
            Else
                For i = 0 To 3
                    SumMoney(i) = .Fields(i).Value
                Next i
            End If
        End If
        .Close
    
    strSQL = "select sum(FBalanceMoney) as SumBalanceMoney from ledger "
    If m_gbyMonth < 12 Then
        strSQL = strSQL & " Where FhouseCode ='" & sHouseCode & "' and   FYear = " & m_gnYear & " and Fmonth = " & m_gbyMonth + 1 & " And FFlag =  " & PREV_MONTH_CLOSE
    Else
        strSQL = strSQL & " Where FhouseCode ='" & sHouseCode & "' and   FYear = " & m_gnYear + 1 & " and Fmonth =1 And FFlag =  " & PREV_YEAR_CLOSE
    End If
        .Open strSQL, m_gDBCnn, adOpenStatic, adLockReadOnly
        If .EOF And .BOF Then
            SumMoney(4) = 0#
        Else
            If Not IsNull(.Fields(0).Value) Then
                SumMoney(4) = .Fields(0).Value
            Else
                SumMoney(4) = 0#
            End If
        End If
        .Close
    End With
    strSQL = "update sumhousemoney set FInmoney =" & SumMoney(0) & ", FDiaoboInmoney=" & SumMoney(1) & ", FOutMOney =" & SumMoney(2) & _
    ", FdiaoboOutmoney= " & SumMoney(3) & ", FBalanceMoney =" & SumMoney(4) & _
    " where FhouseCode = '" & sHouseCode & "' and FYear = " & m_gnYear & "and Fmonth = " & m_gbyMonth & "and FFlag= " & nFlag
    m_gDBCnn.Execute strSQL
    CollectHouse = True
    Exit Function
    
CollectErr:
    CollectHouse = False
End Function
'计算每个库房的月合计
Function CollectMonth() As Boolean
On Error GoTo CollectErr
Dim strSQL As String
Dim HouseRs As ADODB.Recordset
Set HouseRs = New ADODB.Recordset
HouseRs.Open "select  FhouseCode from warehouse", m_gDBCnn, adOpenStatic, adLockReadOnly
'如果本月没有发生,则不计算
If HouseRs.EOF And HouseRs.BOF Then Exit Function
'先删除本月所有记录

strSQL = "delete from sumhousemoney where FYear=" & m_gnYear & " and Fmonth = " & m_gbyMonth
m_gDBCnn.Execute strSQL
strSQL = "insert into sumhousemoney(FHousecode,FYear,Fmonth,FFlag,Fabstract) " & _
        " select FhouseCode," & m_gnYear & "," & m_gbyMonth & "," & THIS_MONTH_SUM & ",'本月合计' from warehouse"
m_gDBCnn.Execute strSQL
If m_gbyMonth Mod 3 = 0 Then
    strSQL = "insert into sumhousemoney(FHousecode,FYear,Fmonth,FFlag,Fabstract) " & _
        " select FhouseCode," & m_gnYear & "," & m_gbyMonth & "," & THIS_SEASON_SUM & ",'本季合计' from warehouse"
    m_gDBCnn.Execute strSQL
End If
If m_gbyMonth = 12 Then
    strSQL = "insert into sumhousemoney(FHousecode,FYear,Fmonth,FFlag,Fabstract) " & _
        " select FhouseCode," & m_gnYear & "," & m_gbyMonth & "," & THIS_YEAR_SUM & ",'本年合计' from warehouse"
    m_gDBCnn.Execute strSQL
    strSQL = "insert into sumhousemoney(FHousecode,FYear,Fmonth,FFlag,Fabstract) " & _
        " select FhouseCode," & m_gnYear & "," & m_gbyMonth & "," & CLOSE_NEXT_YEAR & ",'结转下年' from warehouse"
    m_gDBCnn.Execute strSQL
End If
Do While Not HouseRs.EOF
    If CollectHouse(HouseRs!Fhousecode, THIS_MONTH_SUM, "本月合计") Then GoTo CollectErr
    If m_gbyMonth Mod 3 = 0 Then
        If CollectHouse(HouseRs!Fhousecode, THIS_SEASON_SUM, "本季合计") Then GoTo CollectErr
    End If
    If m_gbyMonth = 12 Then
        If CollectHouse(HouseRs!Fhousecode, THIS_YEAR_SUM, "本年合计") Then GoTo CollectErr
       ' If CollectHouse(HouseRs!FHouseCode, CLOSE_NEXT_YEAR, "结转下年") Then GoTo CollectErr
    End If
    If m_gbyMonth = 1 Then
        If CollectHouse(HouseRs!Fhousecode, PREV_YEAR_CLOSE, "上年结转") Then GoTo CollectErr
    End If
    HouseRs.MoveNext
Loop
CollectMonth = True
Exit Function
CollectErr:
    CollectMonth = False
End Function
Function GetCloseDay(bNextDay As Boolean, ByVal nYear As Integer, ByVal nMonth As Integer) As Date
'25-28 0 dateadd("d",-1,"1999年3月1日")
If nMonth <= 0 Then
    nMonth = 12 + nMonth
    nYear = nYear - 1
End If
Dim CloseAccDate As Date
Dim CloseDay As Integer
Dim rs As ADODB.Recordset

Set rs = New ADODB.Recordset
rs.Open "select FCloseAccDate,FCloseDay from system", m_gDBCnn, adOpenStatic, adLockOptimistic
CloseDay = rs!FCloseDay
CloseAccDate = rs!FCloseAccDate
rs.Close

If bNextDay Then '下月第一日
    If CloseDay <> 0 Then
        GetCloseDay = DateAdd("d", 1, DateSerial(nYear, nMonth, CloseDay))
    Else
        GetCloseDay = DateSerial(nYear, nMonth + 1, 1)
    End If
    If nMonth = 12 Then GetCloseDay = DateSerial(nYear + 1, 1, 1)
Else             '本月结帐日
    If CloseDay = 0 Then
        GetCloseDay = DateAdd("d", -1, DateSerial(nYear, nMonth + 1, 1))
    Else
        GetCloseDay = DateSerial(nYear, nMonth, CloseDay)
    End If
    If nMonth = 12 Then GetCloseDay = DateSerial(nYear, 12, 31)
End If
End Function