mainmodule.bas

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

                LedgerRs!FBalanceMOney = dblQuantity * dblPrice
        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 = dblQuantity * dblPrice
            
            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 = dblQuantity * dblPrice
    
    LedgerRs!FBalanceQuantity = dblOldQuantity + dblQuantity
    
    LedgerRs!FBalanceMOney = curOldMoney + dblQuantity * dblPrice
    
    LedgerRs!FBalancePrice = LedgerRs!FBalanceMOney / LedgerRs!FBalanceQuantity
    
    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
Dim 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
Function KeepRecord(sHouseCode As String, sWarescode As String, sAbstract As String, sNo As String, dblQuantity As Double, dblPrice As Double, CurMoney As Currency, sEntryType As String, sEntryCode As String, Optional nType As Integer = 1) As Boolean
On Error GoTo KeepRecord_Err
KeepRecord = True
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strSQL As String
strSQL = "select * from Ledger where FWarescode = '" & sWarescode & "' and Fhousecode ='" & sHouseCode & "' order by fid"
rs.Open strSQL, m_gDBCnn, adOpenStatic, adLockOptimistic
If rs.EOF And rs.BOF Then
    MsgBox "代码为" & sWarescode & "的商品没有初始,请先初始"
    KeepRecord = False
    Exit Function
End If
rs.MoveLast
Dim OldQuantity As Double
Dim OldPrice As Double
OldQuantity = rs!FBalanceQuantity
OldPrice = rs!FBalancePrice
rs.AddNew
rs!FYear = m_gnYear
rs!FMonth = m_gbyMonth
rs!FNo = sNo

rs!FDate = m_gLoginDate
rs!Fhousecode = sHouseCode
rs!FWaresCode = sWarescode
rs!FAbstract = sAbstract
rs!FEntryType = sEntryType
rs!FEntryCode = sEntryCode
If nType = 1 Then '商品入库
    rs!FFLag = IN_HOUSE_DETAIL
    rs!FInQuantity = dblQuantity
    rs!FInPrice = dblPrice
    rs!FInMoney = CurMoney
'    rs!FBalanceQuantity = OldQuantity + dblQuantity
'    rs!FBalancePrice = IIf(rs!FBalanceQuantity = 0, 0, dblPrice)
'    rs!FBalanceMoney = rs!FBalanceQuantity * rs!FBalancePrice
ElseIf nType = 2 Then '商品出库
    rs!FFLag = OUT_HOUSE_DETAIL
    rs!FOutQuantity = dblQuantity
    rs!FOutPrice = dblPrice
    rs!FOutMoney = CurMoney
'    rs!FBalanceQuantity = OldQuantity - dblQuantity
'    rs!FBalancePrice = IIf(rs!FBalanceQuantity = 0, 0, OldPrice)
'    rs!FBalanceMoney = rs!FBalanceQuantity * rs!FBalancePrice
ElseIf nType = 3 Then '商品调拨出
    rs!FFLag = OUT_DIAO_BO
    rs!FDiaoboOutQuantity = dblQuantity
    rs!FDiaoBooutPrice = dblPrice
    rs!FDiaoboOutMoney = CurMoney
'    rs!FBalanceQuantity = OldQuantity - dblQuantity
'    rs!FBalancePrice = IIf(rs!FBalanceQuantity = 0, 0, OldPrice)
'    rs!FBalanceMoney = rs!FBalanceQuantity * rs!FBalancePrice
ElseIf nType = 4 Then '升耗单
    rs!FFLag = IN_WASTAGE_DETAIL
    If dblQuantity > 0 Then
        rs!FDiaoboInQuantity = dblQuantity
        rs!FDiaoBoInPrice = dblPrice
        rs!FDiaoboInMoney = CurMoney
    Else
        rs!FDiaoboOutQuantity = -dblQuantity
        rs!FDiaoBooutPrice = dblPrice
        rs!FDiaoboOutMoney = CurMoney
    End If
'    rs!FBalanceQuantity = OldQuantity - dblQuantity
'    rs!FBalancePrice = IIf(rs!FBalanceQuantity = 0, 0, OldPrice)
'    rs!FBalanceMoney = rs!FBalanceQuantity * rs!FBalancePrice

End If
rs.Update
rs.Close
KeepRecord = True
Exit Function

KeepRecord_Err:
    KeepRecord = False
End Function
Function PeriodEndKeepRecord() As Boolean
Dim CurrentMonth  As String
Dim CurrentYear As String
Dim CurrentDate As String
CurrentYear = m_gnYear 'GetPrivateSetting("operator", "CurrentYear", "0")
CurrentMonth = m_gbyMonth 'GetPrivateSetting("operator", "CurrentMonth", "0")
CurrentDate = m_gLoginDate 'GetPrivateSetting("operator", "CurrentMonthEnd", "0")
If CurrentYear = "0" Or CurrentMonth = "0" Or CurrentDate = "0" Then
    MsgBox "由帐表传递的结帐日期有误!,不能结帐"
End If
'（1） 检查所有没有记帐的原始凭证（不含代管入出库单、商品损耗单）
'加权
Dim strSQL As String
Dim TableName(4) As String
Dim sFTypeFilter(4) As String
Dim nNextYear As Integer
Dim nNextMonth As Integer
Dim NextDate As Date
If Val(CurrentMonth) = 12 Then
    nNextMonth = 1
    nNextYear = Val(CurrentYear + 1)
Else
    nNextMonth = Val(CurrentMonth) + 1
    nNextYear = Val(CurrentYear)
End If
NextDate = Str(nNextYear) & "/" & Str(nNextMonth) & "/01 "
TableName(0) = "Sell"
sFTypeFilter(0) = ""
TableName(1) = "Stockup"
sFTypeFilter(1) = ""
TableName(2) = "WaresIn"
sFTypeFilter(2) = "And FType <> SURROGATE_INVOICE "
TableName(3) = "WaresOut"
sFTypeFilter(3) = "And  FType <> OUT_OTHER "
'On Error GoTo KeepRecordErr
Dim i  As Integer
m_gDBCnn.BeginTrans
'For i = 0 To 3
'strSQL = "update  " & TableName(i) & _
'" set FYear =" & nNextYear & ",FMonth = " & nNextMonth & ",Fdate=#" & NextDate & "# " & _
'"where Fkeeper ='' or  isnull(Fkeeper) " & sFTypeFilter(i)
''m_gDBCnn.Execute strSQL
'Next i



'，改变原始凭证上的年、月及日期，日期为下个财务月首日
'（2） 按商品计价方法在所有库存商品明细帐上分别写本月合计、上月结转或上年结转（12月）、本季合计（3、6、9、12月）、本年合计,结转下年（12月），填写方法如下：
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

strSQL = "SELECT distinct Ledger.FHouseCode, Ledger.FWaresCode, WaresList.FPriceMode" & _
" FROM Ledger INNER JOIN WaresList ON Ledger.FWaresCode = WaresList.FWaresCode "
rs.Open strSQL, m_gDBCnn, adOpenStatic, adLockReadOnly
If rs.EOF And rs.BOF Then
    MsgBox "没有可结转的数据"
    Exit Function
End If
Dim result As Boolean

Do While Not rs.EOF
    Select Case CurrentMonth
    Case 1, 2, 4, 5, 7, 8, 10, 11
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 1)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 4)
    If Not result Then GoTo KeepRecordErr
    Case 3, 6, 9
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 1)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 2)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 4)
    If Not result Then GoTo KeepRecordErr
    Case 12
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 1)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 2)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 3)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 6)
    If Not result Then GoTo KeepRecordErr
    result = KeepRecordMonth(rs!Fhousecode, rs!FWaresCode, rs!FPriceMode, CurrentYear, CurrentMonth, CurrentDate, 5)
    If Not result Then GoTo KeepRecordErr
    End Select
    
    rs.MoveNext
Loop
m_gDBCnn.CommitTrans
MsgBox "结转帐完毕!"
PeriodEndKeepRecord = True
Exit Function
KeepRecordErr:
    m_gDBCnn.RollbackTrans
    MsgBox "结转帐出错!"
    PeriodEndKeepRecord = False
End Function
'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
'Public Const THIS_MONTH_SUM As Integer = 14     '本月合计
'Public Const THIS_SEASON_TOTAL As Integer = 15  '本季累计
'Public Const THIS_YEAR_TOTAL As Integer = 16    '本年累计
'Public Const THIS_SEASON_SUM As Integer = 17    '本季合计
'Public Const THIS_YEAR_SUM As Integer = 18      '本年合计