frminvoicesettle.frm

金算盘软件代码

    Dim i As Long
    Dim lngNewID As Long
    Dim lngNewTempID As Long
    
    CloneAHead = 0
    On Error GoTo ErrHandle
    strSql = "SELECT * FROM ItemActivity WHERE "
    Set recS = gclsBase.BaseDB.OpenResultset(strSql & " lngActivityID=" & lngSourceID, rdOpenForwardOnly)
    If recS.BOF And recS.EOF Then GoTo EndProc
    lngReceiptTypeID = recS!lngReceiptTypeID
    If lngReceiptTypeID = 52 Or lngReceiptTypeID = 8 Then
        lngReceiptTypeID = 2
        BillPublic.getPrevPlateAndBillNo lngReceiptTypeID, lngNewTempID, strSql
    Else
        lngNewTempID = recS!lngTemplateID
    End If
    Set recD = gclsBase.BaseDB.OpenResultset("SELECT * FROM ItemActivity WHERE ROWNUM < 1", rdOpenDynamic, rdConcurValues)
    With recD
        .AddNew
        lngNewID = GetNewID("ItemActivity")
        !lngActivityID = lngNewID
        !strDate = Format(gclsBase.BaseDate, "YYYY-MM-DD")
        !lngOperatorID = gclsBase.OperatorID
        !intYear = gclsBase.AccountYear
        !bytPeriod = gclsBase.Period
        !strReceiptNo = recS!strReceiptNo
        If recS!lngReceiptTypeID <> 8 Then
            !strNote = "发票核销自动冲销"
            !lngSourceActivityID = lngSourceID
            !lngInvoiceActivityID = mlngActivityID
        Else
            If OptSelect(0).Value = True Then
                !lngInvoiceActivityID = mlngActivityID
            End If
            !strNote = "发票核销自动生成"
        End If
        !lngTemplateID = lngNewTempID
        !lngCustomerID = recS!lngCustomerID
        !lngDepartmentID = recS!lngDepartmentID
        !lngEmployeeID = recS!lngEmployeeID
        !lngClassID1 = recS!lngClassID1
        !lngClassID2 = recS!lngClassID2
        !lngCustomerAddressID = recS!lngCustomerAddressID
        !lngCustomerBankID = recS!lngCustomerBankID
        !lngBusinessAddressID = recS!lngBusinessAddressID
        !lngBusinessBankID = recS!lngBusinessBankID
        !lngAccountID = recS!lngAccountID
        !lngTermID = recS!lngTermID
        !strReceiptDate = recS!strReceiptDate
        !strDueDate = recS!strDueDate
        !blnIsInvoice = 0
        !strInvoiceType = " "
        !strInvoiceNumber = " "
        !lngCurrencyID = recS!lngCurrencyID
        !dblRate = recS!dblRate
        !lngReceiptTypeID = lngReceiptTypeID
        !lngActivityTypeID = lngReceiptTypeID - 1
GetNO:
        If GetNextNO(lngReceiptTypeID, Format(gclsBase.BaseDate, "YYYY-MM-DD"), !strReceiptNo, i) = False Then
            GoTo EndProc
        End If
        !lngReceiptNo = i
        .Update
    End With
    CloneAHead = lngNewID
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:
    If Err.Number = 3022 Then
        If Not recD Is Nothing Then
            Resume GetNO
        End If
    End If
    Resume EndProc
End Function
Private Function CloneADetail(ByVal lngSourceID As Long, ByVal lngReceiptTypeID 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 i As Long
    Dim lngDataRow As Long
    
    On Error GoTo ErrHandle
    strSql = "SELECT * FROM ItemActivityDetail WHERE "
    Set recS = gclsBase.BaseDB.OpenResultset(strSql & " lngActivityDetailID=" & lngSourceID, rdOpenDynamic, rdConcurValues)
    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")
        !lngActivityID = lngNewActivityID
        !lngRowID = lngRowID
        !lngItemID = recS!lngItemID
        !lngUnitID = recS!lngUnitID
        !dblCurrPrice = recS!dblCurrPrice
        !dblCurrPriceTax = recS!dblCurrPriceTax
        !dblDiscountRate = recS!dblDiscountRate
        !lngTaxID = recS!lngTaxID
        !dblPlanPrice = recS!dblPlanPrice
        !lngJobID = recS!lngJobID
        !lngCustomID0 = recS!lngCustomID0
        !lngCustomID1 = recS!lngCustomID1
        !lngCustomID2 = recS!lngCustomID2
        !lngCustomID3 = recS!lngCustomID3
        !lngCustomID4 = recS!lngCustomID4
        !lngCustomID5 = recS!lngCustomID5
        !blnCloseInvoice = 1
        lngDataRow = lngDataRowOfItem(recS!lngItemID)
        !lngPositionID = recS!lngPositionID
        !dblQuantity = -recS!dblQuantity
        !dblCurrAmount = -recS!dblCurrAmount
        !dblAmount = -recS!dblAmount
        !dblCurrTaxAmount = -recS!dblCurrTaxAmount
        !dblTaxAmount = -recS!dblTaxAmount
        !strProduceNum = recS!strProduceNum
        !strProduceDate = recS!strProduceDate
        !strValidDate = recS!strValidDate
        !intValidDay = recS!intValidDay
        If CloneObtendData(lngSourceID, !lngActivityDetailID) = False Then
            GoTo EndProc
        End If
        recS.Requery
        !dblInvoiceQuantity = -recS!dblInvoiceQuantity
        !dblCurrInvoiceAmount = -recS!dblCurrInvoiceAmount
        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
    CloneADetail = 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 CreateANewDetail(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 i As Long
    Dim lngDataRow As Long
    Dim lngSourceID As Long
    
    On Error GoTo ErrHandle
    lngDataRow = GrdCol.RowData(lngRowno)
    lngSourceID = RowDatas(lngDataRow).lngInvoiceDetailID
    strSql = "SELECT * FROM ItemActivityDetail WHERE "
    Set recS = gclsBase.BaseDB.OpenResultset(strSql & " lngActivityDetailID=" & lngSourceID, rdOpenStatic)
    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")
        !lngActivityID = lngNewActivityID
        !lngRowID = lngRowID
        !lngItemID = recS!lngItemID
        !lngUnitID = RowDatas(lngDataRow).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 = C2Dbl(NumberConvert(GrdCol.TextMatrix(lngRowno, xlngColNo(3)), RowDatas(lngDataRow).dblFactor))
        !dblCurrAmount = C2Dbl(GrdCol.TextMatrix(lngRowno, xlngColNo(5))) * recS!dblCurrAmount / (recS!dblCurrAmount + recS!dblCurrTaxAmount)
        !dblCurrTaxAmount = C2Dbl(GrdCol.TextMatrix(lngRowno, xlngColNo(5))) - !dblCurrAmount
        If CreateNewObtendData(recD) = False Then
            GoTo EndProc
        End If
        If GetQAForNewDetail(recD, lngRowno) = False Then
            GoTo EndProc
        End If
        If !dblQuantity <> 0 Then
            !dblCurrPrice = !dblCurrAmount / !dblQuantity
            !dblCurrPriceTax = (!dblCurrAmount + !dblCurrTaxAmount) / !dblQuantity
        End If
        !dblAmount = !dblCurrAmount * (recS!dblAmount / recS!dblCurrAmount)
        !dblTaxAmount = !dblCurrTaxAmount * (recS!dblTaxAmount / recS!dblCurrTaxAmount)
        !dblInvoiceQuantity = !dblQuantity
        !dblCurrInvoiceAmount = !dblCurrAmount + !dblCurrTaxAmount
        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
    CreateANewDetail = 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 GetQAForNewDetail(recNew As rdoResultset, ByVal lngRowno As Long) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim lngDataRow As Long
    Dim dblTmp As Double

    lngDataRow = GrdCol.RowData(lngRowno)
    strSql = "SELECT PTIO.* " & _
        " FROM ItemActivityDetail IADI,PurchaseToInvoice PTI,ItemActivityDetail IADR," & _
        " PurchaseToInvoice PTIO,ItemActivityDetail IADIO " & _
        " WHERE IADI.lngActivityDetailID=PTI.lngInvoiceDetailID " & _
        " AND PTI.lngReceiptDetailID=IADR.lngActivityDetailID " & _
        " AND IADR.lngActivityDetailID=PTIO.lngReceiptDetailID " & _
        " AND PTIO.lngInvoiceDetailID=IADIO.lngActivityDetailID " & _
        " AND IADIO.lngActivityID<>" & mlngActivityID & _
        " AND IADI.lngActivityID=" & mlngActivityID & _
        " AND IADI.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
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTmp
        Do While Not .EOF
            recNew!dblQuantity = recNew!dblQuantity + !dblQuantity
            dblTmp = recNew!dblCurrAmount + recNew!dblCurrTaxAmount