frmclosecost.frm

金算盘软件代码

    End If
End Sub


'卡片新增（摘要）
Private Sub lstxtRemark_Choose()
    mRemarkID = lstxtRemark.ID
End Sub
Private Sub lstxtRemark_AddNew()
    mRemarkID = Card.AddCard(msgRemark)
    RefreshRemark mRemarkID
End Sub
Private Sub lstxtRemark_Edit()
    If mRemarkID > 0 Then
        Card.EditCard msgRemark, mRemarkID
        RefreshRemark
    End If
End Sub
Private Sub lstxtRemark_Delete()
    If mRemarkID > 0 Then
        If Card.DelCard(msgRemark, mRemarkID) Then
            RefreshRemark
        End If
    End If
End Sub

Private Sub RefreshVoucherType(Optional lngID As Long)
    If Not lstxtType.Resultset Is Nothing Then
        Utility.RemoveListRecordSet lrtVoucherType
    End If
    On Error Resume Next
    lstxtType.ClearRefer
    Set lstxtType.Resultset = Utility.GetListRecordSet(lrtVoucherType)
    On Error GoTo 0
    lstxtType.Comparts = 2
    lstxtType.AddRefer "<新增>"
    lstxtType.AddRefer "<修改>"
    lstxtType.AddRefer "<删除>"
    If lngID > 0 Then
        lstxtType.SeekId lngID
    Else
        If Not lstxtType.Resultset Is Nothing Then
            lstxtType.ReferRow = 4 + IIf(lstxtType.Resultset.RowCount > 0, lstxtType.Resultset.RowCount - 1, 0)
        Else
            lstxtType.Text = ""
        End If
    End If
End Sub

Private Sub RefreshTemplate(Optional lngID As Long)
    Dim strSql As String
    Dim strCondVersion As String
    Dim recType As rdoResultset
    Dim lngFormatID As Long
    
    On Error Resume Next
    
    strSql = "SELECT strVoucherFormat FROM VoucherType WHERE lngVoucherTypeID=" & lstxtType.ID
    Set recType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recType.EOF Then
        Select Case recType!strVoucherFormat
        Case "1" ' 收款凭证 "
            lngFormatID = 54
        Case "2" ' 付款凭证
            lngFormatID = 55
        Case Else
            lngFormatID = 41
        End Select
    Else
        lngFormatID = 41
    End If
    recType.Close
    Set recType = Nothing
    mlngFormatID = lngFormatID
    
    lstxtTemplate.ClearRefer
    strCondVersion = " And (Mod(bytVersion ," & gVersionType * 2 & ")>=" & gVersionType & ")"
    strSql = "SELECT lngTemplateID, strTemplateName  From Template " _
           & "Where lngReceiptTypeID=" & lngFormatID & " And blnIsInActive = 0 " & strCondVersion _
           & " ORDER BY lngTemplateID"
    Set lstxtTemplate.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    lstxtTemplate.Comparts = 2
    lstxtTemplate.AddRefer "<新增>"
    lstxtTemplate.AddRefer "<修改>"
    lstxtTemplate.AddRefer "<删除>"
    If lngID > 0 Then
        lstxtTemplate.SeekId lngID
        If lstxtTemplate.ID = 0 Then
            lstxtTemplate.ReferRow = 4
        End If
    Else
        If Not lstxtTemplate.Resultset Is Nothing Then
            lstxtTemplate.ReferRow = 4
        Else
            lstxtTemplate.Text = ""
        End If
    End If
End Sub

Private Sub RefreshRemark(Optional lngID As Long)
    Dim strSql As String
    On Error Resume Next
    lstxtRemark.ClearRefer
    strSql = "SELECT lngRemarkID,strRemarkName FROM Remark"
    Set lstxtRemark.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    lstxtRemark.Comparts = 2
    lstxtRemark.AddRefer "<新增>"
    lstxtRemark.AddRefer "<修改>"
    lstxtRemark.AddRefer "<删除>"
    If lngID > 0 Then
        lstxtRemark.SeekId lngID
    Else
        If Not lstxtRemark.Resultset Is Nothing Then
            lstxtRemark.ReferRow = 4
        Else
            lstxtRemark.Text = ""
        End If
    End If
End Sub

Private Sub msgPeriod_RowColChange()
    lblPeriod.Caption = msgPeriod.TextMatrix(msgPeriod.Row, 2)
End Sub

'成本结转
Private Sub GenCostVoucher()
    Dim strSql As String
    Dim recSum As rdoResultset
    Dim blnClose As Boolean, lngCnt As Long
    Dim intPeriod As Integer, intYear As Integer
    Dim dtmStart As Date, dtmEnd As Date
    Dim dblAmount As Double, dblSaleTax As Double
    Dim lngDebitAccount As Long, lngCreditAccount As Long
    Dim lngSaleTaxAccount As Long, lngLendAccountID As Long
    Dim lngStageAccountID As Long, lngEntrustAccountID As Long
    Dim lngLoop As Long, lngNatureID As Long, lngFirst As Long, errNo As Long
    Dim recNature As rdoResultset
    
    On Error GoTo ErrHandle
    
    intYear = gclsBase.FYearOfDate(gclsBase.BaseDate)
    
    InitVoucherRecord VoucherData
    
    gclsBase.DateOfPeriod intYear, mintPeriod, dtmStart, dtmEnd
    lngEntrustAccountID = GetSet(1, "特殊科目", "委托加工", 0)
    lngLendAccountID = GetSet(1, "特殊科目", "委托代销商品", 0)
    lngStageAccountID = GetSet(1, "特殊科目", "分期收款发出商品", 0)
    
    '打开进度尺
    prgLoad.Value = 0
    prgLoad.Max = 100
    prgLoad.ZOrder 0
    prgLoad.Visible = True
    lngFirst = 0
    lngNatureID = 0

    strSql = "SELECT lngItemID,lngActivityTypeID,Sum(dblCostDiff) As dblCostDiffs,Sum(dblSaleTax) As dblSaleTaxs " _
        & "FROM ItemActivity,ItemActivityDetail " _
        & "WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " _
        & "AND strDate>='" & Format(dtmStart, "yyyy-mm-dd") & "' " _
        & "AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") & "' AND (blnIsVoid=0) " _
        & "AND (lngActivityTypeID IN(" & atOutSale & "," & atOutLend & "," & atOutStage & "," _
        & atOutEntrust & ")) " _
        & "GROUP BY lngItemID,lngActivityTypeID"
    Set recSum = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Do While Not recSum.EOF
        strSql = "SELECT ItemNature.* FROM ItemNature,Item " _
            & "WHERE ItemNature.lngItemNatureID=Item.lngItemNatureID " _
            & "AND lngItemID=" & recSum!lngItemID
        Set recNature = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recNature.EOF Then
            dblAmount = 0
            dblSaleTax = 0
            Select Case recNature!strCostMethod
            Case cmPlan
                Select Case recSum!lngActivityTypeID
                Case atOutSale '销售
                    dblAmount = recSum!dblCostDiffs
                    lngDebitAccount = recNature!lngCostAccountID
                    lngCreditAccount = recNature!lngDiffAccountID
                Case atOutEntrust '加工
                    dblAmount = recSum!dblCostDiffs
                    lngDebitAccount = lngEntrustAccountID
                    lngCreditAccount = recNature!lngDiffAccountID
                Case atOutLend '委托
                    dblAmount = recSum!dblCostDiffs
                    lngDebitAccount = recNature!lngCostAccountID
                    lngCreditAccount = recNature!lngDiffAccountID
                Case atOutStage '分期
                    dblAmount = recSum!dblCostDiffs
                    lngDebitAccount = recNature!lngCostAccountID
                    lngCreditAccount = recNature!lngDiffAccountID
                End Select
            Case cmRealDiff
                Select Case recSum!lngActivityTypeID
                Case atOutSale '销售
                    dblAmount = -recSum!dblCostDiffs
                    dblSaleTax = recSum!dblSaleTaxs
                    lngDebitAccount = recNature!lngDiffAccountID
                    lngSaleTaxAccount = recNature!lngStockTaxAccountID
                    lngCreditAccount = recNature!lngCostAccountID
                Case atOutEntrust '加工
                    dblAmount = -recSum!dblCostDiffs
                    dblSaleTax = recSum!dblSaleTaxs
                    lngDebitAccount = recNature!lngDiffAccountID
                    lngSaleTaxAccount = recNature!lngStockTaxAccountID
                    lngCreditAccount = lngEntrustAccountID
                Case atOutLend '委托
                    dblAmount = -recSum!dblCostDiffs
                    dblSaleTax = recSum!dblSaleTaxs
                    lngDebitAccount = recNature!lngDiffAccountID
                    lngSaleTaxAccount = recNature!lngStockTaxAccountID
                    lngCreditAccount = recNature!lngCostAccountID
                Case atOutStage '分期
                    dblAmount = -recSum!dblCostDiffs
                    dblSaleTax = recSum!dblSaleTaxs
                    lngDebitAccount = recNature!lngDiffAccountID
                    lngSaleTaxAccount = recNature!lngStockTaxAccountID
                    lngCreditAccount = recNature!lngCostAccountID
                End Select
            End Select
            dblAmount = AdjustDec(dblAmount, gclsBase.NaturalCurDec)
            dblSaleTax = AdjustDec(dblSaleTax, gclsBase.NaturalCurDec)
            If (lngDebitAccount = 0 Or lngCreditAccount = 0 Or recNature!strCostMethod = cmRealDiff And lngSaleTaxAccount = 0) And dblAmount <> 0 Then
                 ShowMsg hwnd, "商品没有指定对应科目！", vbExclamation + vbOKOnly, Caption
                VoucherData(0).Used = False
                ReDim VoucherData(0).Detail(0)
                prgLoad.Visible = False
                recSum.Close
                recNature.Close
                Exit Sub
            End If
            If dblAmount <> 0 Or dblSaleTax <> 0 Then
                With VoucherData(0)
                    If Not .Used Then
                        .Used = True
                        .VoucherSourceID = vsCost
                        .VoucherTypeID = mVoucherTypeID
                        .OperatorID = gclsBase.OperatorID
                        .TemplateID = mTemplateID
                        .VoucherDate = Format(dtmEnd, "YYYY-MM-DD")
                        ReDim Preserve .Detail(0)
                    End If
                    
                    '设置借方
                    For lngCnt = lngFirst To UBound(.Detail)
                        If .Detail(lngCnt).AccountID = 0 Then
                            .Detail(lngCnt).AccountID = lngDebitAccount
                            .Detail(lngCnt).Attribute = AccountAttribute(lngDebitAccount)
                            .Detail(lngCnt).Direction = adDebit
                            If recNature!strCostMethod = "6" Then
                                .Detail(lngCnt).Remark = "成本差异结转(" & recNature!strItemNatureName & ")"
                            Else
                                .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & ")"
                            End If
                            Exit For
                        Else
                            If .Detail(lngCnt).AccountID = lngDebitAccount And _
                                .Detail(lngCnt).Direction = adDebit Then
                                Exit For
                            End If
                        End If
                    Next lngCnt
                    If lngCnt > UBound(.Detail) Then
                        lngCnt = UBound(.Detail) + 1
                        ReDim Preserve .Detail(lngCnt)
                        .Detail(lngCnt).AccountID = lngDebitAccount
                        .Detail(lngCnt).Attribute = AccountAttribute(lngDebitAccount)
                        .Detail(lngCnt).Direction = adDebit
                        If recNature!strCostMethod = "6" Then
                            .Detail(lngCnt).Remark = "成本差异结转(" & recNature!strItemNatureName & ")"
                        Else
                            .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & ")"
                        End If
                    End If
                    .Detail(lngCnt).Amount = .Detail(lngCnt).Amount + dblAmount
                    
                    '待实现销项税(借方)
                    If recNature!strCostMethod = cmRealDiff And dblSaleTax <> 0 Then
                        For lngCnt = lngFirst To UBound(.Detail)
                            If .Detail(lngCnt).AccountID = 0 Then
                                .Detail(lngCnt).AccountID = lngSaleTaxAccount
                                .Detail(lngCnt).Attribute = AccountAttribute(lngSaleTaxAccount)
                                .Detail(lngCnt).Direction = adDebit
                                .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & "," & MethodName(recNature!strCostMethod) & ")"
                                Exit For
                            Else
                                If .Detail(lngCnt).AccountID = lngSaleTaxAccount And _
                                    .Detail(lngCnt).Direction = adDebit Then
                                    Exit For
                                End If
                            End If
                        Next lngCnt
                        If lngCnt > UBound(.Detail) Then
                            lngCnt = UBound(.Detail) + 1
                            ReDim Preserve .Detail(lngCnt)
                            .Detail(lngCnt).AccountID = lngSaleTaxAccount
                            .Detail(lngCnt).Attribute = AccountAttribute(lngSaleTaxAccount)
                            .Detail(lngCnt).Direction = adDebit
                            .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & ")"
                        End If
                        .Detail(lngCnt).Amount = .Detail(lngCnt).Amount + dblSaleTax
                    End If

                    '设置贷方
                    For lngCnt = lngFirst To UBound(.Detail)
                        If .Detail(lngCnt).AccountID = 0 Then
                            .Detail(lngCnt).AccountID = lngCreditAccount
                            .Detail(lngCnt).Attribute = AccountAttribute(lngCreditAccount)
                            .Detail(lngCnt).Direction = adCredit
                            If recNature!strCostMethod = "6" Then
                                .Detail(lngCnt).Remark = "成本差异结转(" & recNature!strItemNatureName & ")"
                            Else
                                .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & ")"
                            End If
                            Exit For
                        Else
                            If .Detail(lngCnt).AccountID = lngCreditAccount And _
                                .Detail(lngCnt).Direction = adCredit Then
                                Exit For
                            End If
                        End If
                    Next lngCnt
                    If lngCnt > UBound(.Detail) Then
                        lngCnt = UBound(.Detail) + 1
                        ReDim Preserve .Detail(lngCnt)
                        .Detail(lngCnt).AccountID = lngCreditAccount
                        .Detail(lngCnt).Attribute = AccountAttribute(lngCreditAccount)
                        .Detail(lngCnt).Direction = adCredit
                        If recNature!strCostMethod = "6" Then
                            .Detail(lngCnt).Remark = "成本差异结转(" & recNature!strItemNatureName & ")"
                        Else
                            .Detail(lngCnt).Remark = "进销差价结转(" & recNature!strItemNatureName & ")"
                        End If
                    End If
                    .Detail(lngCnt).Amount = .Detail(lngCnt).Amount + (dblAmount + dblSaleTax)
                End With
            End If
            lngNatureID = recNature!lngItemNatureID
            If lngNatureID <> recNature!lngItemNatureID And VoucherData(0).Used Then
                lngFirst = UBound(VoucherData(0).Detail) + 1
            End If
        End If
        recNature.Close
        prgLoad.Value = recSum.PercentPosition
        recSum.MoveNext
    Loop
    recSum.Close
    Set recNature = Nothing
    Set recSum = Nothing
    
    '关闭进度尺
    prgLoad.Visible = False
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
    VoucherData(0).IsError = True
End Sub