costcalculate.bas

金算盘软件代码

    refUpdate.rdoParameters(7).Value = Trim(strProduceNum)
    refUpdate.rdoParameters(8).Value = lngCustomID0
    refUpdate.rdoParameters(9).Value = lngCustomID1
    refUpdate.rdoParameters(10).Value = lngCustomID2
    refUpdate.rdoParameters(11).Value = lngCustomID3
    refUpdate.rdoParameters(12).Value = lngCustomID4
    refUpdate.rdoParameters(13).Value = lngCustomID5
    refUpdate.Execute
    refUpdate.Close
    Set refUpdate = Nothing
End Sub

'根据计算方法得到代码
Public Function MethodCode(ByVal strMethod As String) As String
    Select Case strMethod
    Case "全月平均"
        MethodCode = cmMonthAvg
    Case "移动平均"
        MethodCode = cmMoveAvg
    Case "先进先出"
        MethodCode = cmFIFO
    Case "后进先出"
        MethodCode = cmLIFO
    Case "个别计价"
        MethodCode = cmSingle
    Case "计划价"
        MethodCode = cmPlan
    Case "进销差价率"
        MethodCode = cmRealDiff
    Case "最后进价"
        MethodCode = cmLastPrice
    Case Else
        MethodCode = ""
    End Select
End Function

'根据计算代码得到名称
Public Function MethodName(ByVal strMethod As String) As String
    Select Case strMethod
    Case cmMonthAvg
        MethodName = "全月平均"
    Case cmMoveAvg
        MethodName = "移动平均"
    Case cmFIFO
        MethodName = "先进先出"
    Case cmLIFO
        MethodName = "后进先出"
    Case cmSingle
        MethodName = "个别计价"
    Case cmPlan
        MethodName = "计划价"
    Case cmRealDiff
        MethodName = "进销差价率"
    Case cmLastPrice
        MethodName = "最后进价"
    Case Else
        MethodName = ""
    End Select
End Function

'根据红字计算方法得到代码
Public Function NegativeMethodCode(ByVal strMethod As String) As String
    Select Case strMethod
    Case "不计算成本"
        NegativeMethodCode = "0"
    Case "计划价"
        NegativeMethodCode = "1"
    Case "移动平均价"
        NegativeMethodCode = "2"
    Case "最近进价"
        NegativeMethodCode = "3"
    Case "最高进价"
        NegativeMethodCode = "4"
    Case "最低进价"
        NegativeMethodCode = "5"
    Case "平均进价"
        NegativeMethodCode = "6"
    Case "上月结存价"
        NegativeMethodCode = "7"
    Case "上月差价率", "上月差异率"
        NegativeMethodCode = "8"
    Case "上季差价率", "上季差异率"
        NegativeMethodCode = "9"
    Case "上年差价率", "上季差异率"
        NegativeMethodCode = "10"
    Case Else
        NegativeMethodCode = "0"
    End Select
End Function

'根据红字计算代码得到名称
Public Function NegativeMethodName(ByVal strMethod As String) As String
    Select Case strMethod
    Case ncmNoCost
        NegativeMethodName = "不计算成本"
    Case ncmPlan
        NegativeMethodName = "计划价"
    Case ncmMoveAvg
        NegativeMethodName = "移动平均价"
    Case ncmLaterPrice
        NegativeMethodName = "最近进价"
    Case ncmMaxPrice
        NegativeMethodName = "最高进价"
    Case ncmMinPrice
        NegativeMethodName = "最低进价"
    Case ncmAvgPrice
        NegativeMethodName = "平均进价"
    Case ncmLastPrice
        NegativeMethodName = "上月结存价"
    Case ncmLastDiffRate
        NegativeMethodName = "上月差价率"
    Case ncmLastQuarterDiffRate
        NegativeMethodName = "上季差价率"
    Case ncmLastYearDiffRate
        NegativeMethodName = "上年差价率"
    Case Else
        NegativeMethodName = "不计算成本"
    End Select
End Function


Public Function PeriodNum(ByVal intYear As Integer) As Integer
    Dim errNo As Long
    Dim strSql As String
    Dim recPeriod As rdoResultset
    
    On Error GoTo ErrHandle
    
    strSql = "SELECT bytPeriodNo FROM AccountYear WHERE intYear=" & intYear
    Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recPeriod.EOF Then
        PeriodNum = recPeriod!bytPeriodNO
    End If
    Set recPeriod = Nothing
    Exit Function

ErrHandle:
    errNo = Errors.ErrorsDeal()
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg frmMain.hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, "计算成本"
    End Select
End Function

Public Function MinBetween(ByVal First As Double, ByVal Second As Double) As Double
    If First > Second Then
        MinBetween = Second
    Else
        MinBetween = First
    End If
End Function

Public Function MaxBetween(ByVal First As Double, ByVal Second As Double) As Double
    If First < Second Then
        MaxBetween = Second
    Else
        MaxBetween = First
    End If
End Function

Public Function GetbytPeriod(ByVal strPeriod As String) As Integer
    If strPeriod = "本期末" Then
        GetbytPeriod = gclsBase.Period
    Else
        GetbytPeriod = CInt(Mid$(strPeriod, 6, 2))
    End If
End Function

Public Function GetintYear(ByVal strPeriod As String) As Integer
    If strPeriod = "本期末" Then
        GetintYear = gclsBase.AccountYear
    Else
        GetintYear = CInt(Mid$(strPeriod, 1, 4))
    End If
End Function

Public Function TostrPeriod(ByVal dtmDate As Date) As String
    TostrPeriod = gclsBase.FYearOfDate(dtmDate) & "年" & Format(gclsBase.PeriodOfDate(dtmDate), "00") & "期末"
End Function

Public Function ItemName(ByVal lngItemID As Long) As String
    Dim strSql As String
    Dim recItem As rdoResultset
    
    strSql = "SELECT strItemCode,strItemName FROM Item WHERE lngItemID=" & lngItemID
    Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recItem.EOF Then
        ItemName = recItem!strItemCode & " " & recItem!strItemName
    End If
    recItem.Close
    Set recItem = Nothing
End Function

Public Function GetQItemDaily2OraSql(BeginDate As String, EndDate As String) As String
    Dim strSql As String
    
    strSql = "SELECT lngItemID," _
        & "SUM(dblPurchaseQuantity+dblEntrustInQuantity+dblCheckUpQuantity+dblInQuantity) AS dblInQuantitys," _
        & "SUM(dblPurchaseAmount+dblEntrustInAmount+dblCheckUpAmount" _
        & "+dblInAmount+dblCostInAmount+dblAdjPriceAdd-dblAdjPriceDec) AS dblInAmounts," _
        & "SUM(dblPurchaseExpense+dblEntrustExpense) AS dblExpenses," _
        & "SUM(dblSaleQuantity+dblLendQuantity+dblStageQuantity+dblEntrustOutQuantity+dblCheckDownQuantity" _
        & "+dblOutQuantity) AS dblOutQuantitys," _
        & "SUM(dblSaleCost+dblLendCost+dblStageCost+dblEntrustOutAmount+dblCheckDownAmount+dblOutAmount) AS dblOutAmounts," _
        & "SUM(dblPurchaseDiffDebit-dblPurchaseDiffCredit+dblInDiffDebit-dblInDiffCredit+dblCostInDiffDebit" _
        & "-dblCostInDiffCredit-dblAdjPriceAdd-dblAdjPriceAddSaleTax+dblAdjPriceDec+dblAdjPriceDecSaleTax) AS dblInDiffs," _
        & "SUM(dblSaleCostDiff+dblLendCostDiff+dblStageCostDiff+dblCostOutDiff) AS dblOutDiffs," _
        & "SUM(dblPurchaseSaleTaxDebit-dblPurchaseSaleTaxCredit+dblInSaleTaxDebit-dblInSaleTaxCredit+" _
        & "dblCostInSaleTaxDebit-dblCostInSaleTaxCredit-dblAdjPriceAddSaleTax+dblAdjPriceDecSaleTax) AS dblInSaleTaxs," _
        & "SUM(-dblSaleCostSaleTax-dblLendCostSaleTax-dblStageCostSaleTax-dblCostOutSaleTax) AS dblOutSaleTaxs," _
        & "SUM(dblCostAdj+dblCostCostAdj) AS dblCostDiffAdjusts," _
        & "SUM(dblCostCostAdj) AS dblOutAdjDiffs," _
        & "SUM(dblCostAdj+dblCostCostAdj) AS dblCostAdjusts " _
        & "FROM ItemDaily2 " _
        & "WHERE strDate>='" & BeginDate & "' AND strDate<='" & EndDate & "' " _
        & "GROUP BY lngItemID"
    GetQItemDaily2OraSql = strSql
End Function

Public Function GetQItemInit2OraSql(BeginDate As String) As String
    Dim strSql As String
    
    strSql = "SELECT lngItemID," _
        & "SUM(dblPurchaseQuantity+dblEntrustInQuantity+dblCheckUpQuantity+dblInQuantity-dblSaleQuantity" _
        & "-dblLendQuantity-dblStageQuantity-dblEntrustOutQuantity-dblCheckDownQuantity-dblOutQuantity) AS dblInitQuantitys, " _
        & "SUM(dblPurchaseAmount+dblEntrustInAmount+dblCheckUpAmount+dblInAmount" _
        & "+dblCostInAmount+dblAdjPriceAdd-dblSaleCost-dblLendCost-dblStageCost-dblEntrustOutAmount" _
        & "-dblCheckDownAmount-dblOutAmount-dblAdjPriceDec) AS dblInitAmounts," _
        & "SUM(dblPurchaseExpense+dblEntrustExpense) AS dblInitExpenses," _
        & "SUM(dblPurchaseDiffDebit-dblPurchaseDiffCredit+dblInDiffDebit-dblInDiffCredit+dblCostInDiffDebit" _
        & "-dblCostInDiffCredit-dblAdjPriceAdd-dblAdjPriceAddSaleTax+dblAdjPriceDec+dblAdjPriceDecSaleTax) AS dblInitInDiffs," _
        & "SUM(dblSaleCostDiff+dblLendCostDiff+dblStageCostDiff+dblCostOutDiff) AS dblInitOutDiffs," _
        & "SUM(dblPurchaseSaleTaxDebit-dblPurchaseSaleTaxCredit+dblInSaleTaxDebit-dblInSaleTaxCredit" _
        & "+dblCostInSaleTaxDebit-dblCostInSaleTaxCredit-dblAdjPriceAddSaleTax+dblSaleCostSaleTax" _
        & "+dblLendCostSaleTax+dblStageCostSaleTax+dblCostOutSaleTax+dblAdjPriceDecSaleTax) AS dblInitSaleTaxs," _
        & "SUM(dblCostAdj+dblCostCostAdj) AS dblInitCostDiffAdjusts," _
        & "SUM(dblCostAdj+dblCostCostAdj) AS dblInitCostAdjusts " _
        & "FROM ItemDaily2 " _
        & "WHERE strDate<'" & BeginDate & "' " _
        & "GROUP BY lngItemID"
    GetQItemInit2OraSql = strSql
End Function