mainmodule.bas

针对农资系统的商品进销存管理系统软件

                LedgerRs!FMonth = m_gbyMonth
                LedgerRs!Fhousecode = sHouseCode
                LedgerRs!FWaresCode = sWarescode
                LedgerRs!FNo = sNo
               
                ' LedgerRs!FAbstract = "商品出库"
                LedgerRs!FDate = m_gLoginDate
                LedgerRs!FFlag = OUT_HOUSE_DETAIL

                LedgerRs.Update
                LedgerRs.MoveNext
            End If
            DuplicateRs.MoveNext
        Loop
    Else
        RecPos = DuplicateRs.AbsolutePosition
        DuplicateRs.MoveFirst
        Do While DuplicateRs.AbsolutePosition <= RecPos And DuplicateRs.AbsolutePosition > 0
            If Not LedgerRs.EOF Then
                If DuplicateRs.AbsolutePosition = RecPos Then
                    LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity - dblQuantity
                Else
                    LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity
                End If
                
                LedgerRs!FbalancePrice = DuplicateRs!FbalancePrice
                LedgerRs!FBalanceMoney = Format(LedgerRs!FbalancePrice * LedgerRs!FBalanceQuantity, MoneyFormat())
                LedgerRs.Update
                LedgerRs.MoveNext
                
            Else
                LedgerRs.AddNew
                LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity
                LedgerRs!FbalancePrice = DuplicateRs!FbalancePrice
                LedgerRs!FBalanceMoney = DuplicateRs!FBalanceMoney
                
                LedgerRs!FYear = m_gnYear
                LedgerRs!FMonth = m_gbyMonth
                LedgerRs!Fhousecode = sHouseCode
                LedgerRs!FWaresCode = sWarescode
                LedgerRs!FNo = sNo
                LedgerRs!FDate = m_gLoginDate
                ' LedgerRs!FAbstract = "商品出库"
                LedgerRs!FFlag = OUT_HOUSE_DETAIL

                LedgerRs.Update
                LedgerRs.MoveNext
            End If
            DuplicateRs.MoveNext
        Loop
'            If Not IsNull(LedgerRs!FOutQuantity) Then
'                LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity - dblQuantity
'                LedgerRs!FBalancePrice = DuplicateRs!FBalancePrice
'                LedgerRs!FBalanceMoney = DuplicateRs!FBalanceMoney - Format(DuplicateRs!FBalancePrice * dblQuantity, MoneyFormat())
'                LedgerRs.Update
'                LedgerRs.MoveNext
'            Else
'                LedgerRs.AddNew
'                LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity
'                LedgerRs!FBalancePrice = DuplicateRs!FBalancePrice
'                LedgerRs!FBalanceMoney = DuplicateRs!FBalanceMoney
'
'                LedgerRs!FYear = m_gnYear
'                LedgerRs!FMonth = m_gbyMonth
'                LedgerRs!FHouseCode = sHouseCode
'                LedgerRs!FWaresCode = sWarescode
'                LedgerRs!FNo = sNo
'                LedgerRs!FDate = m_gLoginDate
'                LedgerRs!FFlag = OUT_HOUSE_DETAIL
'                LedgerRs.Update
'            End If
        
    End If
    'e.若为移动平均: 结存栏按结存数量?结存金额计算结存单价?
    'f． 若为加权平均：结存栏仅记数量，不记单价与金额。
    Case MOVE_AVER_MODE, WEIGHT_AVER_MODE
   
    LedgerRs.Open "select * from ledger where FhouseCode='" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FFlag <" & THIS_DAY_SUM & " order by FId", m_gDBCnn, adOpenStatic, adLockOptimistic
    LedgerRs.MoveLast
    
    dblOldQuantity = LedgerRs!FBalanceQuantity
    dblOldPrice = LedgerRs!FbalancePrice
    curOldMoney = LedgerRs!FBalanceMoney
    LedgerRs.AddNew
    LedgerRs!FOutQuantity = dblQuantity
    LedgerRs!FOutPrice = dblOldPrice
    LedgerRs!FOutMoney = dblQuantity * dblOldPrice
    
    MoneySum = MoneySum + LedgerRs!FOutMoney
     
    LedgerRs!FBalanceQuantity = dblOldQuantity - dblQuantity
    LedgerRs!FbalancePrice = dblOldPrice
    LedgerRs!FBalanceMoney = curOldMoney - Format(dblQuantity * dblOldPrice, MoneyFormat())
    
    LedgerRs!FYear = m_gnYear
    LedgerRs!FMonth = m_gbyMonth
    LedgerRs!Fhousecode = sHouseCode
    LedgerRs!FWaresCode = sWarescode
    LedgerRs!FNo = sNo
    LedgerRs!FAbstract = "商品出库"
    LedgerRs!FDate = m_gLoginDate
    LedgerRs!FFlag = OUT_HOUSE_DETAIL
    LedgerRs.Update
    
End Select
'更新balanceb 表 FQuantity
Edit_Balance:
Dim strSQL As String
Dim nAffected As Integer

strSQL = "update balance set FQuantity =FQuantity - " & tempQuantity & ",FReferencedQuantity =FReferencedQuantity - " & tempQuantity & " where FHouseCode = '" & sHouseCode & "' and FwaresCode ='" & sWarescode & "'"
m_gDBCnn.Execute strSQL, nAffected
If nAffected <> 1 Then GoTo Data_Err
CalculatePrice = True
Exit Function
Data_Err:
CalculatePrice = False
End Function

'记帐 入库单 出库单 写balance 、ledger表
Function Keep_Business_Records(nYear As Integer, nMonth As Byte, nType As Integer, sNo As String, Optional bWaresOut As Boolean = True, Optional bOuterHouse As Boolean = True) As Boolean
'On Error GoTo Update_Data_Err
 
 If bWaresOut Then '出库单
 Dim rs As ADODB.Recordset
 
 Dim strSQL As String
 Dim bSuccess As Boolean
 Dim MoneySum As Currency
 Dim nAffected As Integer
 Set rs = New ADODB.Recordset
 strSQL = "SELECT OutDetail.FWaresCode,waresout.FHouseCode, OutDetail.FQuantity,OutDetail.FPrice,OutDetail.FMoney, WaresList.FPriceMode" & _
 " FROM (waresout INNER JOIN OutDetail ON (waresout.FYear = OutDetail.FYear) AND (waresout.FMonth = OutDetail.FMonth) AND (waresout.FType = OutDetail.FType) AND (waresout.FNo = OutDetail.FNo)) INNER JOIN WaresList ON OutDetail.FWaresCode = WaresList.FWaresCode " & _
 " where  waresout.FYear = " & nYear & " and  waresout.FMonth=" & nMonth & " and  waresout.FType=" & nType & " and waresout.FNo='" & sNo & "'"
 rs.Open strSQL, m_gDBCnn, adOpenStatic, adLockOptimistic
 Do While Not rs.EOF
    If nType <> OUT_RED Then
          bSuccess = CalculatePrice(rs!FWaresCode, rs!Fhousecode, rs!FQuantity, rs!FPriceMode, sNo, MoneySum)
          
          If Not bSuccess Then GoTo Update_Data_Err
          strSQL = "update outdetail set Fmoney = " & MoneySum & ", Fprice = Format(" & MoneySum & "/FQuantity, '" & PriceFormat() & "') " & _
          "where  outdetail.FYear = " & nYear & " and  outdetail.FMonth=" & nMonth & " and  outdetail.FType=" & nType & " and outdetail.FNo='" & sNo & "' and FWaresCode='" & rs!FWaresCode & "'"
        
          m_gDBCnn.Execute strSQL, nAffected
          If nAffected <> 1 Then GoTo Update_Data_Err
    Else '如果是退货出库
          bSuccess = Red_Keeper(rs!FWaresCode, rs!Fhousecode, rs!FQuantity, rs!FPriceMode, sNo, rs!FPrice)
          
          If Not bSuccess Then GoTo Update_Data_Err
    End If
      rs.MoveNext
 Loop
 Else '入库单
 
 End If

 Keep_Business_Records = True
 Exit Function
Update_Data_Err:
' MsgBox "记帐出错，请与供应商联系。"
 Keep_Business_Records = False
End Function

Function Red_Keeper(sWarescode As String, sHouseCode As String, dblQuantity As Double, nPriceMode As Integer, sNo As String, dblPrice As Double) As Boolean
''//WaresList表中FPriceMode定义:
'Public Const FIFO_MODE = 0              '先进先出
'Public Const WEIGHT_AVER_MODE = 1       '加权平均
'Public Const MOVE_AVER_MODE = 2         '移动平均
'Public Const LIFO_MODE = 3              '后进先出
'm_gnYear = 1999
'm_gbyMonth = 9
'm_gLoginDate = Date

On Error GoTo Data_Err:
Dim LedgerRs As New ADODB.Recordset
    Dim sTempNo As String
    Dim nTempFlag As Integer
    Dim dblOldQuantity As Double, dblOldPrice As Double, curOldMoney As Currency
    Dim tempQuantity As Double
    Dim bFirstRecord As Boolean
    bFirstRecord = True
    tempQuantity = dblQuantity
Select Case nPriceMode
    Case FIFO_MODE, LIFO_MODE
    
    LedgerRs.Open "select Fno,FFlag from ledger where FhouseCode='" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FFlag <" & THIS_DAY_SUM & "  order by FId", m_gDBCnn, adOpenStatic, adLockReadOnly
    If Not (LedgerRs.EOF And LedgerRs.BOF) Then
        LedgerRs.MoveLast
        sTempNo = LedgerRs!FNo
        nTempFlag = LedgerRs!FFlag
    Else
        MsgBox "应用程序出错,请与供应商联系"
        Exit Function
    End If
    LedgerRs.Close
    
    Dim DuplicateRs As ADODB.Recordset
   
    Set DuplicateRs = New ADODB.Recordset
    DuplicateRs.CursorLocation = adUseClient
    DuplicateRs.Open "select * from ledger where FhouseCode='" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FNo = '" & sTempNo & "' and FFlag = " & nTempFlag & " and FbalanceQuantity <>'' and not isnull(FbalanceQuantity)  order by FId", m_gDBCnn, adOpenStatic, adLockOptimistic
    
    LedgerRs.CursorLocation = adUseClient
    LedgerRs.Open "select * from ledger where FhouseCode='" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FNo = '" & sNo & "'  and FFlag = " & nTempFlag & " order by FId", m_gDBCnn, adOpenStatic, adLockOptimistic
     
        LedgerRs.AddNew
        LedgerRs!FOutQuantity = -dblQuantity
        LedgerRs!FOutPrice = dblPrice
        LedgerRs!FOutMoney = Format(-dblQuantity * dblPrice, MoneyFormat())
        
        LedgerRs!FYear = m_gnYear
        LedgerRs!FMonth = m_gbyMonth
        LedgerRs!Fhousecode = sHouseCode
        LedgerRs!FWaresCode = sWarescode
        LedgerRs!FNo = sNo
        If bFirstRecord Then
            LedgerRs!FAbstract = "商品退货"
            bFirstRecord = False
        End If
        LedgerRs!FDate = m_gLoginDate
        LedgerRs!FFlag = OUT_RETURN_DETAIL
        If Not (DuplicateRs.EOF And DuplicateRs.BOF) Then
            DuplicateRs.MoveFirst
                LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity
                LedgerRs!FbalancePrice = DuplicateRs!FbalancePrice
                LedgerRs!FBalanceMoney = DuplicateRs!FBalanceMoney
                DuplicateRs.MoveNext
        Else
                LedgerRs!FBalanceQuantity = dblQuantity
                LedgerRs!FbalancePrice = dblPrice
                LedgerRs!FBalanceMoney = Format(dblQuantity * dblPrice, MoneyFormat())
        End If
        LedgerRs.Update
        Do While Not DuplicateRs.EOF
            LedgerRs.AddNew
            LedgerRs!FBalanceQuantity = DuplicateRs!FBalanceQuantity
            LedgerRs!FbalancePrice = DuplicateRs!FbalancePrice
            LedgerRs!FBalanceMoney = DuplicateRs!FBalanceMoney
            LedgerRs!FYear = m_gnYear
            LedgerRs!FMonth = m_gbyMonth
            LedgerRs!Fhousecode = sHouseCode
            LedgerRs!FWaresCode = sWarescode
            LedgerRs!FNo = sNo
            'LedgerRs!FAbstract = "商品退货"
            LedgerRs!FDate = m_gLoginDate
            LedgerRs!FFlag = OUT_RETURN_DETAIL
            LedgerRs.Update
        Loop
          If Not (DuplicateRs.EOF And DuplicateRs.BOF) Then
            LedgerRs.AddNew
            LedgerRs!FBalanceQuantity = dblQuantity
            LedgerRs!FbalancePrice = dblPrice
            LedgerRs!FBalanceMoney = Format(dblQuantity * dblPrice, MoneyFormat())
            
            LedgerRs!FYear = m_gnYear
            LedgerRs!FMonth = m_gbyMonth
            LedgerRs!Fhousecode = sHouseCode
            LedgerRs!FWaresCode = sWarescode
            LedgerRs!FNo = sNo
           ' LedgerRs!FAbstract = "商品退货"
            LedgerRs!FDate = m_gLoginDate
            LedgerRs!FFlag = OUT_RETURN_DETAIL
            LedgerRs.Update
        
         End If
        '如果没有结存, 则直接到修改balance 表
        
    
    'e.若为移动平均: 结存栏按结存数量?结存金额计算结存单价?
    'f． 若为加权平均：结存栏仅记数量，不记单价与金额。
    Case MOVE_AVER_MODE, WEIGHT_AVER_MODE
   
    LedgerRs.Open "select * from ledger where FhouseCode='" & sHouseCode & "' and FWaresCode = '" & sWarescode & "' and FFlag <" & THIS_DAY_SUM & " order by FId", m_gDBCnn, adOpenStatic, adLockOptimistic
    LedgerRs.MoveLast
    
    dblOldQuantity = LedgerRs!FBalanceQuantity
    dblOldPrice = LedgerRs!FbalancePrice
    curOldMoney = LedgerRs!FBalanceMoney
    
    LedgerRs.AddNew
    LedgerRs!FOutQuantity = -dblQuantity
    LedgerRs!FOutPrice = dblPrice
    LedgerRs!FOutMoney = Format(dblQuantity * dblPrice, MoneyFormat())
    
    LedgerRs!FBalanceQuantity = dblOldQuantity + dblQuantity
    
    LedgerRs!FBalanceMoney = curOldMoney + Format(dblQuantity * dblPrice, MoneyFormat())
    
    LedgerRs!FbalancePrice = Format(LedgerRs!FBalanceMoney / LedgerRs!FBalanceQuantity, PriceFormat())
    
    LedgerRs!FYear = m_gnYear
    LedgerRs!FMonth = m_gbyMonth
    LedgerRs!Fhousecode = sHouseCode
    LedgerRs!FWaresCode = sWarescode
    LedgerRs!FNo = sNo
    LedgerRs!FAbstract = "商品退货"
    LedgerRs!FDate = m_gLoginDate
    LedgerRs!FFlag = OUT_RETURN_DETAIL
    LedgerRs.Update
    
End Select
'更新balanceb 表 FQuantity
Edit_Balance:
Dim strSQL As String
Dim nAffected As Integer

strSQL = "update balance set FQuantity =FQuantity + " & tempQuantity & ",FReferencedQuantity=FReferencedQuantity  -" & tempQuantity & " where FHouseCode = '" & sHouseCode & "' and FwaresCode ='" & sWarescode & "'"
m_gDBCnn.Execute strSQL, nAffected
If nAffected <> 1 Then GoTo Data_Err
Red_Keeper = True
Exit Function
Data_Err:
Red_Keeper = False
End Function

'////////////////////////////////////////////////////
'//
Function GetNextSeriesLength(sParentCode As String) As Integer
    GetNextSeriesLength = m_gSeriesLen(GetThisSeriesNum(sParentCode))
End Function

'根据代码返回级数(第  级)
Function GetThisSeriesNum(sSeriesCode) As Integer
    Dim nLen As Integer, i As Integer
    i = 0
    nLen = Len(sSeriesCode)
    Do While nLen <> 0
        nLen = nLen - m_gSeriesLen(i)
        i = i + 1
    Loop
    GetThisSeriesNum = i
End Function

Function GetParentCode(sSeriesCode) As String
    Dim nLen As Integer
    
    nLen = Len(sSeriesCode) - m_gSeriesLen(GetThisSeriesNum(sSeriesCode) - 1)
    GetParentCode = Left(sSeriesCode, nLen)
End Function