mainmodule.bas

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

'Public Const CLOSE_NEXT_YEAR As Integer = 19    '结转下年
Function KeepRecordMonth(sHouseCode As String, sWarescode As String, nPriceMode As Integer, ByVal sYear As String, ByVal sMonth As String, sDate As String, nSumType As Integer) As Boolean
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strSQL As String
Dim nFlag As Integer
Dim strAbstract As String
Dim strSumFilter As String
Select Case nSumType
Case 1  '本月合计
    nFlag = THIS_MONTH_SUM
    strAbstract = "本月合计"
    strSumFilter = " FYear = " & sYear & " and Fmonth =" & sMonth
  
Case 2  '本季合计
    nFlag = THIS_SEASON_SUM
    strAbstract = "本季合计"
    strSumFilter = " FYear = " & Val(sYear) & " and Fmonth >= " & (Val(sMonth) - 2) & " and fmonth <=" & Val(sMonth)
Case 3  '本年合计
    nFlag = THIS_YEAR_SUM
    strAbstract = "本年合计"
    strSumFilter = " FYear = " & sYear
Case 4 '上月结转
    nFlag = PREV_MONTH_CLOSE
    strAbstract = "上月结转"
    strSumFilter = " FYear = " & sYear & " and Fmonth =" & sMonth
    KeepRecordMonth = True
    Exit Function
Case 5 '上年结转
    nFlag = PREV_YEAR_CLOSE
    strAbstract = "上年结转"
    strSumFilter = " FYear = " & sYear
Case 6 '结转下年
    nFlag = CLOSE_NEXT_YEAR
    strAbstract = "结转下年"
    strSumFilter = " FYear = " & sYear

End Select
'On Error GoTo KeepErr:

'本月合计
strSQL = "SELECT Sum(Ledger.FInQuantity) AS SumInQuantity, Sum(Ledger.FInMoney) AS SumInMoney, Sum(Ledger.FOutQuantity) AS SumOutQuantity, Sum(Ledger.FOutMoney) AS SumOutMoney, Sum(Ledger.FDiaoBoInMoney) AS SumDiaoBoInMoney, Sum(Ledger.FDiaoBoInQuantity) AS SumDiaoBoInQuantity, Sum(Ledger.FDiaoBoOutQuantity) AS SumDiaoBoOutQuantity, Sum(Ledger.FDiaoBoOutMoney) AS SumDiaoboOutMoney FROM Ledger " & _
 "where FHouseCode = '" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FFlag >1 and FFlag <13 and"
 
 strSQL = strSQL & strSumFilter
rs.Open strSQL, m_gDBCnn, adOpenStatic, adLockReadOnly
If IsNull(rs!SuminQuantity) And IsNull(rs!SumOutQuantity) And (nSumType < 4 Or nSumType = 6) Then
    
        KeepRecordMonth = True
        Exit Function
    
Else
    If nSumType = 6 Then '结转下年
        strSQL = "insert into ledger  (FYear,Fmonth,FHouseCode,FWaresCode,FFlag,FDate,FAbstract,FOutQuantity,FOutMoney,FInquantity,FInMoney)" & _
              " select  " & Val(sYear) & "," & Val(sMonth) & ",'" & sHouseCode & "','" & sWarescode & "'," & nFlag & ",#" & sDate & "#,'" & strAbstract & "'," & rs!SuminQuantity & "," & rs!SuminMOney & ", " & rs!SumOutQuantity & "," & rs!SumOutMoney
        m_gDBCnn.Execute strSQL
        KeepRecordMonth = True
        Exit Function
    End If
   '先写结存
   Dim tempQuantity As Double
        Dim tempMoney As Currency
        Dim tempPrice As Double
    Dim rs2 As ADODB.Recordset
        Set rs2 = New ADODB.Recordset
       
            strSQL = "select * from ledger where  FHouseCode ='" & sHouseCode & "' and FWaresCode ='" & sWarescode & "' order by fid"
       
        rs2.Open strSQL, m_gDBCnn, adOpenStatic, adLockOptimistic
        
   Select Case nPriceMode
   Case FIFO_MODE, LIFO_MODE '0,3
        Dim Rs1 As ADODB.Recordset
        Set Rs1 = New ADODB.Recordset  ',FAbstract,FInquantity,FInMoney,FOutQuantity,FOutMoney,
        If nSumType < 4 Then
            strSQL = "select * from ledger where " & strSumFilter & " and FFlag>1 and Fflag<13 and FWaresCode='" & sWarescode & "' and FHouseCode='" & sHouseCode & "' And FAbstract <>'' and not isnull(FAbstract)"
        Else
            strSQL = "select * from ledger where " & strSumFilter & " and  Fflag<13 and FWaresCode='" & sWarescode & "' and FHouseCode='" & sHouseCode & "' And FAbstract <>'' and not isnull(FAbstract)"
        End If
        Rs1.Open strSQL, m_gDBCnn, adOpenStatic, adLockReadOnly
        Rs1.MoveLast
        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
        strSQL = "insert into ledger (FYear,Fmonth,FHouseCode,FWaresCode,FFlag,FDate,FBalancequantity,FBalancePrice,FBalanceMoney) " & _
        "select  " & Val(sYear) & "," & Val(sMonth) & ",'" & sHouseCode & "','" & sWarescode & "'," & nFlag & ",#" & sDate & "#,FBalancequantity,FBalancePrice,FBalanceMoney from Ledger " & _
        " where FHouseCode ='" & sHouseCode & "' and FWaresCode ='" & sWarescode & "' and FFlag=" & Rs1!FFLag & " and " & IIf(IsNull(Rs1!FNo), "isNULL(Fno)", "fno='" & Rs1!FNo & "'") & " and FBalanceQuantity<>0"
        Dim RecordsAffected  As Integer
        

        m_gDBCnn.Execute strSQL, RecordsAffected
        Rs1.Close
        strSQL = "select * from Ledger Where  FHouseCode ='" & sHouseCode & "' and FWaresCode ='" & sWarescode & "' and FFlag=" & nFlag & " and FYear =" & Val(sYear) & " and Fmonth=" & Val(sMonth)
        Rs1.Open strSQL, m_gDBCnn, adOpenStatic, adLockOptimistic
        Rs1!FAbstract = strAbstract
        If nSumType < 4 Then
            If Not IsNull(rs!SuminQuantity) Then
                Rs1!FInQuantity = rs!SuminQuantity
                Rs1!FInMoney = rs!SuminMOney
            End If
            If Not IsNull(rs!SumOutQuantity) Then
                Rs1!FOutQuantity = rs!SumOutQuantity
                Rs1!FOutMoney = rs!SumOutMoney
            End If
        End If
        Rs1.Update
        Rs1.Close
        
   Case WEIGHT_AVER_MODE '1 加权平均
        Dim CurLastBalanceMoney As Currency '上期结存金额
        Dim CurLastBalanceQuantity As Double '上期结存数量
        Dim nID As Integer
        rs2.Filter = "FBalanceQuantity<>0 " 'THIS_MONTH_SUM,PREV_YEAR_CLOSE,PREV_MONTH_CLOSE
        
        If rs2.EOF And rs2.BOF Then '没有结存的话,则认为结存为0
            CurLastBalanceMoney = 0
            CurLastBalanceQuantity = 0
        Else
            rs2.MoveLast
            CurLastBalanceMoney = rs2!FBalanceMOney
            CurLastBalanceQuantity = rs2!FBalanceQuantity
            nID = rs2!FId
            rs2.Filter = "Fid > 72 And FFLag = 14"  '"Fid > " & nID & " and (FFlag=14 or FFlag=1 or FFLag =0)"
            rs2.MoveLast
            If rs2.RecordCount > 1 Then
                CurLastBalanceMoney = 0
                CurLastBalanceQuantity = 0
            End If
        End If
        
        'rs2.Filter = "FFlag=" & THIS_MONTH_SUM & " or FFlag= " & PREV_YEAR_CLOSE
        '先找上月的末纪录
'        rs2.Filter = "Fmonth<" & m_gbyMonth & " and  FFlag<13"
'
'        If rs2.EOF And rs2.BOF Then
'            '再找本月的上年结转
'            rs2.Filter = "Fmonth=" & m_gbyMonth & " and  FFlag=0"
'            If rs2.EOF And rs2.BOF Then
'                CurLastBalanceMoney = 0
'            Else
'                rs2.MoveLast
'                CurLastBalanceMoney = rs2!FBalanceMOney
'            End If
'        Else
'            rs2.MoveLast
'            CurLastBalanceMoney = rs2!FBalanceMOney
'        End If
'
'        rs2.MoveLast
'
'
'        rs2.Filter = strSumFilter & " and FFlag<13 "
'
'        rs2.MoveFirst
'
'        tempQuantity = rs2!FBalanceQuantity
'        tempMoney = rs2!FBalanceMOney
'
'        rs2.MoveLast
'        If tempQuantity <> 0 Then
'            tempPrice = (rs2!FBalanceMOney + tempMoney) / (rs2!FBalanceQuantity + tempQuantity)
'        Else
'            tempPrice = 0
'        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
        rs2.Filter = 0
         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
        If nSumType = 5 Or nSumType = 4 Then
            rs2!FBalanceQuantity = tempQuantity
            rs2!FBalancePrice = tempPrice
            rs2!FBalanceMOney = tempMoney
        End If
        rs2.Update
        If nSumType = 1 Then '本月合计 写销售成本、销售差价
            rs2.MovePrevious
            
            rs2!FBalanceQuantity = tempQuantity
            rs2!FBalancePrice = tempPrice
            rs2!FBalanceMOney = tempMoney
            rs2!FSellBaseMoney = CurLastBalanceMoney + rs!SuminMOney + rs!SumDiaoboInMoney - tempMoney - rs!SumDiaoboOutMoney
            rs2!FSellChaJiaMoney = rs!SumOutMoney - rs2!FSellBaseMoney
            rs2.Update
        End If
        
        
   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