frminvoicesettle.frm

金算盘软件代码

            recNew!dblCurrAmount = recNew!dblCurrAmount + !dblCurrAmount * recNew!dblCurrAmount / dblTmp
            recNew!dblCurrTaxAmount = recNew!dblCurrTaxAmount + !dblCurrAmount * recNew!dblCurrTaxAmount / dblTmp
            strSql = "INSERT INTO PurchaseToInvoice (lngReceiptDetailID,lngInvoiceDetailID,dblQuantity,dblCurrAmount) Values(" & _
                recNew!lngActivityDetailID & "," & !lngInvoiceDetailID & "," & !dblQuantity & "," & !dblCurrAmount & ")"
            If gclsBase.ExecSQL(strSql) = False Then GoTo EndProc
            .MoveNext
        Loop
    End With
    GetQAForNewDetail = True
EndProc:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
End Function
Private Function CreateAAdjustDetail(ByVal lngRowno As Long, ByVal lngRowID As Long, ByVal lngNewActivityID As Long) As Boolean
    Dim strSql As String
    Dim recS As rdoResultset
    Dim recD As rdoResultset
    Dim recTmp As rdoResultset
    Dim i As Long
    Dim lngDataRow As Long
    Dim dblCurrAmount As Double
    Dim lngReceiptDetailID As Long
    
    On Error GoTo ErrHandle
    lngDataRow = GrdCol.RowData(lngRowno)
    strSql = "SELECT * FROM ItemActivityDetail WHERE "
    Set recS = gclsBase.BaseDB.OpenResultset(strSql & " lngItemID=" & RowDatas(lngDataRow).lngItemID & _
        " AND lngActivityID=" & mlngActivityID, rdOpenForwardOnly)
    If recS.BOF And recS.EOF Then GoTo EndProc
    Set recD = gclsBase.BaseDB.OpenResultset(strSql & " ROWNUM < 1", rdOpenDynamic, rdConcurValues)
    With recD
        .AddNew
        !lngActivityDetailID = GetNewID("ItemActivityDetail")
        lngReceiptDetailID = !lngActivityDetailID
        !lngActivityID = lngNewActivityID
        !lngRowID = lngRowID
        !lngItemID = recS!lngItemID
        !lngUnitID = recS!lngUnitID
        !dblCurrPrice = recS!dblCurrPrice
        !dblCurrPriceTax = recS!dblCurrPriceTax
        !dblDiscountRate = 100
        !lngTaxID = recS!lngTaxID
        !dblPlanPrice = recS!dblPlanPrice
        !lngJobID = RowDatas(lngDataRow).lngJobID
        !lngCustomID0 = RowDatas(lngDataRow).lngCustomID0
        !lngCustomID1 = RowDatas(lngDataRow).lngCustomID1
        !lngCustomID2 = RowDatas(lngDataRow).lngCustomID2
        !lngCustomID3 = RowDatas(lngDataRow).lngCustomID3
        !lngCustomID4 = RowDatas(lngDataRow).lngCustomID4
        !lngCustomID5 = RowDatas(lngDataRow).lngCustomID5
        !blnCloseInvoice = 1

        If RowDatas(lngDataRow).strItemCategory = "1" Then
            If RowDatas(lngDataRow).lngStockPositionID <> 0 Then
                !lngPositionID = RowDatas(lngDataRow).lngStockPositionID
            Else
                !lngPositionID = mlngDefaultPositionID
            End If
        End If
        If RowDatas(lngDataRow).blnIsBatch Then
            !strProduceNum = RowDatas(lngDataRow).strProduceNum
        End If
        If RowDatas(lngDataRow).intValidDay <> 0 Then
            !strProduceDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
            !intValidDay = RowDatas(lngDataRow).intValidDay
            !strValidDate = Format(DateAdd("d", !intValidDay, gclsBase.BaseDate), "yyyy-mm-dd")
        End If
        !dblQuantity = 0
        dblCurrAmount = C2Dbl(GrdCol.TextMatrix(lngRowno, xlngColNo(6)))
        !dblCurrAmount = recS!dblCurrAmount * dblCurrAmount / (recS!dblCurrAmount + recS!dblCurrTaxAmount)
        !dblAmount = recS!dblAmount * dblCurrAmount / (recS!dblCurrAmount + recS!dblCurrTaxAmount)
        !dblCurrTaxAmount = recS!dblCurrTaxAmount * dblCurrAmount / (recS!dblCurrAmount + recS!dblCurrTaxAmount)
        !dblTaxAmount = recS!dblTaxAmount * dblCurrAmount / (recS!dblCurrAmount + recS!dblCurrTaxAmount)
        !dblInvoiceQuantity = 0
        !dblCurrInvoiceAmount = dblCurrAmount
        If RowDatas(lngDataRow).strCostMethod = "6" Then
            !dblPlanPrice = RowDatas(lngDataRow).dblPlanPrice
        ElseIf RowDatas(lngDataRow).strCostMethod = "7" Then
            !dblPlanPrice = RowDatas(lngDataRow).dblRetainPrice
        End If
        If RowDatas(lngDataRow).strCostMethod = "6" Then       ' 6 计划价(进价核算)
            !dblCostAmount = Format(!dblPlanPrice * !dblQuantity, FormatString(gclsBase.NaturalCurDec))
            !dblCostDiff = !dblAmount + !dblExpenseAmount - !dblCostAmount
            !dblSaleTax = 0
        ElseIf RowDatas(lngDataRow).strCostMethod = "7" Then       ' 7   实际差价率
            !dblCostAmount = Format(RowDatas(lngDataRow).dblRetainPrice * !dblQuantity, FormatString(gclsBase.NaturalCurDec))
            !dblSaleTax = Format((!dblCostAmount) * RowDatas(lngDataRow).dblTaxRate, FormatString(gclsBase.NaturalCurDec))
            !dblCostDiff = !dblAmount + !dblExpenseAmount - !dblCostAmount + !dblSaleTax
        Else
            !dblCostAmount = !dblAmount
            !dblCostDiff = 0
            !dblSaleTax = 0
        End If
        If RowDatas(lngDataRow).strItemCategory = "1" Then
            !dblAvgCostAmount = !dblCostAmount
        End If
        If RowDatas(lngDataRow).strCostMethod <> "6" And RowDatas(lngDataRow).strCostMethod <> "7" Then
            !dblCtrlPrice = RowDatas(lngDataRow).dblRetainPrice
            !dblCtrlAmount = !dblCtrlPrice * !dblQuantity
        End If
        .Update
    End With
    strSql = "SELECT IADR.lngActivityDetailID,IADR.dblCurrAmount+IADR.dblCurrTaxAmount-SUM(PurchaseToInvoice.dblCurrAmount) " & _
        " FROM ItemActivityDetail IADR,PurchaseToInvoice " & _
        " WHERE IADR.lngActivityDetailID=PurchaseToInvoice.lngReceiptDetailID " & _
        " AND IADR.lngItemID=" & RowDatas(lngDataRow).lngItemID
    If RowDatas(lngDataRow).blnIsBatch Then
        strSql = strSql & _
            " AND IADR.strProduceNum='" & RowDatas(lngDataRow).strProduceNum & "'" & _
            " AND IADR.intValidDay=" & RowDatas(lngDataRow).intValidDay & _
            " AND IADR.lngJobID=" & RowDatas(lngDataRow).lngJobID & _
            " AND IADR.lngCustomID0=" & RowDatas(lngDataRow).lngCustomID0 & _
            " AND IADR.lngCustomID1=" & RowDatas(lngDataRow).lngCustomID1 & _
            " AND IADR.lngCustomID2=" & RowDatas(lngDataRow).lngCustomID2 & _
            " AND IADR.lngCustomID3=" & RowDatas(lngDataRow).lngCustomID3 & _
            " AND IADR.lngCustomID4=" & RowDatas(lngDataRow).lngCustomID4 & _
            " AND IADR.lngCustomID5=" & RowDatas(lngDataRow).lngCustomID5
    End If
    strSql = strSql & _
        " AND EXISTS(SELECT IADI.lngActivityDetailID " & _
        " FROM PurchaseToInvoice,ItemActivityDetail IADI " & _
        " WHERE PurchaseToInvoice.lngInvoiceDetailID=IADI.lngActivityDetailID " & _
        " AND PurchaseToInvoice.lngReceiptDetailID=IADR.lngActivityDetailID" & _
        " AND IADI.lngActivityID=" & mlngActivityID & _
        " ) GROUP BY IADR.lngActivityDetailID,IADR.dblCurrAmount,IADR.dblCurrTaxAmount "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recTmp.EOF
        If recTmp(1) <> 0 Then
            strSql = "UPDATE PurchaseToInvoice SET dblCurrAmount=dblCurrAmount+" & recTmp(1) & _
                " WHERE lngReceiptDetailID=" & recTmp(0) & _
                " AND lngInvoiceDetailID=" & RowDatas(lngDataRow).lngInvoiceDetailID
            If gclsBase.ExecSQL(strSql) = False Then GoTo EndProc
            strSql = "UPDATE ItemActivityDetail SET dblCurrInvoiceAmount=dblCurrInvoiceAmount+" & recTmp(1) & _
                " WHERE lngActivityDetailID=" & recTmp(0)
            If gclsBase.ExecSQL(strSql) = False Then GoTo EndProc
        End If
        recTmp.MoveNext
    Loop
    recTmp.Close
    Set recTmp = Nothing
    strSql = "SELECT IADI.lngActivityDetailID,IADI.dblCurrAmount+IADI.dblCurrTaxAmount-SUM(PurchaseToInvoice.dblCurrAmount) " & _
        " FROM ItemActivityDetail IADI,PurchaseToInvoice " & _
        " WHERE IADI.lngActivityDetailID=PurchaseToInvoice.lngInvoiceDetailID " & _
        " AND IADI.lngActivityID=" & mlngActivityID & _
        " AND IADI.lngItemID=" & RowDatas(lngDataRow).lngItemID
    strSql = strSql & " GROUP BY IADI.lngActivityDetailID,IADI.dblCurrAmount,IADI.dblCurrTaxAmount "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    Do While Not recTmp.EOF
        If dblCurrAmount * recTmp(1) < 0 Then
            strSql = "INSERT INTO PurchaseToInvoice (lngReceiptDetailID,lngInvoiceDetailID,dblQuantity,dblCurrAmount) Values(" & _
                lngReceiptDetailID & "," & recTmp!lngActivityDetailID & ",0," & -recTmp(1) & ")"
            dblCurrAmount = dblCurrAmount + recTmp(1)
        ElseIf Abs(dblCurrAmount) < Abs(recTmp(1)) Then
            strSql = "INSERT INTO PurchaseToInvoice (lngReceiptDetailID,lngInvoiceDetailID,dblQuantity,dblCurrAmount) Values(" & _
                lngReceiptDetailID & "," & recTmp!lngActivityDetailID & ",0," & dblCurrAmount & ")"
            dblCurrAmount = 0
        Else
            strSql = "INSERT INTO PurchaseToInvoice (lngReceiptDetailID,lngInvoiceDetailID,dblQuantity,dblCurrAmount) Values(" & _
                lngReceiptDetailID & "," & recTmp!lngActivityDetailID & ",0," & recTmp(1) & ")"
            dblCurrAmount = dblCurrAmount - recTmp(1)
        End If
        If gclsBase.ExecSQL(strSql) = False Then GoTo EndProc
        If dblCurrAmount = 0 Then
            Exit Do
        End If
        recTmp.MoveNext
    Loop
    CreateAAdjustDetail = True
EndProc:
    If Not recS Is Nothing Then
        recS.Close
        Set recS = Nothing
    End If
    If Not recD Is Nothing Then
        recD.Close
        Set recD = Nothing
    End If
    Exit Function
ErrHandle:
    Resume EndProc
End Function

Private Function GetNextNO(ByVal lngReceiptTypeID As Long, _
    ByVal strDate As String, ByVal strAlpha As String, ByRef lngNo As Long) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim intYear As Integer
    Dim bytPeriod As Integer
    
    On Error GoTo ErrHandle
    intYear = gclsBase.FYearOfDate(C2Date(strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(strDate))
    
    
    strSql = "SELECT MAX(lngReceiptNO) FROM ItemActivity " & _
        " WHERE intYear=" & intYear & " AND bytPeriod=" & bytPeriod & _
        " AND strReceiptNO='" & strAlpha & "'"
    strSql = strSql & " AND lngReceiptTypeID=" & lngReceiptTypeID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If Not (recTmp.BOF And recTmp.EOF) Then
        If IsNull(recTmp(0)) Then
            lngNo = 1
            blnModifyMaxNO intYear, bytPeriod, lngReceiptTypeID, strAlpha, lngNo
            GetNextNO = True
        ElseIf recTmp(0) < 9999 Then
            If lngNo <> recTmp(0) + 1 Then
                lngNo = recTmp(0) + 1
                blnModifyMaxNO intYear, bytPeriod, lngReceiptTypeID, strAlpha, lngNo
                GetNextNO = True
            End If
        End If
    End If
ErrHandle:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
End Function

Private Function ChangeBalance(ByVal lngReceiptTypeID As Long, ByVal lngNewActivityID As Long) As Boolean
    Select Case lngReceiptTypeID
    Case 3 '直运采购
        '修改商品表及采购销售订单明细表
        If Not ModifyItemTable(lngNewActivityID) Then
            GoTo EndProc
        End If
    Case 5 '受托结算
        If ModifyRelation(lngNewActivityID, lngReceiptTypeID, True, Me.hWnd) = 0 Then
            GoTo EndProc
        End If
    Case 7 '加工费用
        '修改商品表及采购销售订单明细表
        If Not ModifyItemTable(lngNewActivityID) Then
            GoTo EndProc
        End If
    Case Else
        '修改商品表及采购销售订单明细表
        If Not ModifyItemTable(lngNewActivityID) Then
            GoTo EndProc
        End If
    End Select
    '修改各种余额表
    If Not ChangeAllItem_from_Activity("I", lngNewActivityID) Then
        GoTo EndProc
    End If

    '修改科目余额
    '商品采购、直运采购、受托结算、加工费用
    Select Case lngReceiptTypeID
    Case 2, 3, 5, 7
        If Not ChangeAllAccount_from_Activity("I", lngNewActivityID) Then
            GoTo EndProc
        End If
    End Select
    gclsSys.SendMessage 0, msgReceipt1 + lngReceiptTypeID - 1
    ChangeBalance = True
EndProc:
End Function

Private Function ModifyPositionInfoDetail(recTmp As rdoResultset) As Boolean
    '修改货位批次明细表
    With recTmp
        ModifyPositionInfoDetail = ModifyPositionALine(!lngActivityDetailID, _
            !lngItemID, !lngPositionID, Abs(!dblQuantity), (!dblQuantity > 0), Me.hWnd)
    End With
End Function

Private Function lngDataRowOfItem(ByVal lngItemID As Long) As Long
    Dim i As Long
    
    For i = 1 To GrdCol.Rows - 1
        If RowDatas(i).lngItemID = lngItemID Then
            lngDataRowOfItem = i
            Exit For
        End If
    Next
End Function

'Private Function dblGetAdjustAmount(recSource As rdoResultset) As Double
'    Dim strSql As String
'    Dim recTmp As rdoResultset
'    Dim dblTmp As Double
'
'    strSql = "SELECT IADP.lngActivityDetailID AS lngDetailIDP, " & _
'        " IADP.dblCurrAmount AS dblCurrAmountP,IADP.dblCurrTaxAmount AS dblCurrTaxAmountP," & _
'        " IADP.dblCurrInvoiceAmount AS dblCurrInvoiceAmountP," & _
'        " PurchaseToInvoice.dblCurrAmount AS dblCurrAmountT" & _
'        " FROM (ItemActivityDetail AS IADI LEFT JOIN PurchaseToInvoice " & _
'        " ON IADI.lngActivityDetailID=PurchaseToInvoice.lngInvoiceDetailID) " & _
'        " LEFT JOIN ItemActivityDetail IADP ON PurchaseToInvoice.lngReceiptDetailID=IADP.lngActivityDetailID " & _
'        " WHERE IADI.lngActivityDetailID=" & recSource!lngActivityDetailID
'    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    With recTmp
'        Do While Not .EOF
'            If IsNull(!lngDetailIDP) Then
'                dblGetAdjustAmount = recSource!dblCurrAmount + recSource!dblCurrTaxAmount
'                strSql = "UPDATE ItemActivityDetail SET dblCurrInvoiceAmount=dblCurrAmount+dblCurrTaxAmount " & _
'                    " WHERE lngActivityDetailID=" & recSource!lngActivityDetailID
'                gclsBase.ExecSQL strSql
'                GoTo ErrHandle
'            Else
'                dblTmp = !dblCurrAmountP + !dblCurrTaxAmountP - !dblCurrInvoiceAmountP
'                If dblTmp <> 0 Then
'                    strSql = "UPDATE PurchaseToInvoice SET dblCurrAmount=dblCurrAmount+" & dblTmp & _
'                        " WHERE PurchaseToInvoice.lngReceiptDetailID=" & !lngDetailIDP & _
'                        " AND PurchaseToInvoice.lngInvoiceDetailID=" & recSource!lngActivityDetailID
'                    gclsBase.ExecSQL strSql
'                End If
'