frmwaressell.frm

针对农资系统的商品进销存管理系统软件

                 promptstr = "下列商品在相应库房没有足够数量 " & vbCr
                 Do While Not Rs.EOF
                     promptstr = promptstr & Rs!FWaresCode & vbCr
                     Rs.MoveNext
                 Loop
                 Rs.Close
                 MsgBox promptstr, vbOKOnly + vbInformation, "警告"
                 Exit Sub
             End If
             Rs.Close
        Else
            
           
            '如果原销售单据号为空,提示用户输入
            If Not CheckSellNo(txtSellNo.Text) Then
                Dim result As Integer
                result = MsgBox("输入单据号无效!,如果是使用本软件后销售的商品,请务必输入原销售单据号,要重新输入单据号吗?", vbYesNo + vbExclamation + vbDefaultButton1, "提示：")
                If result = vbYes Then
                    cmdEdit_Click
                    txtSellNo.SetFocus
                    Exit Sub
                Else
                    GoTo Check_Pass
                End If
          
            End If
            '继续检查 退货明细
            sqlstr = "SELECT FWaresCode From SellDetail" & _
                     " where Ftype =" & REDSELL_INVOICE & " and Fno='" & !FNo & "' and " & _
                     " FWaresCode not in (select FwaresCode From selldetail " & _
                     " where Ftype =" & SELL_INVOICE & " and Fno='" & !FSellNo & "')"
            Rs.Open sqlstr, m_gDBCnn, adOpenStatic, adLockReadOnly
            If Not (Rs.EOF And Rs.BOF) Then
                promptstr = "在相应销售单没有销售过下列商品 " & vbCr
                 Do While Not Rs.EOF
                     promptstr = promptstr & Rs!FWaresCode & vbCr
                     Rs.MoveNext
                 Loop
                 Rs.Close
                 MsgBox promptstr, vbOKOnly + vbInformation, "警告"
                 Exit Sub
            End If
            Rs.Close
            '检查时相应销售单是否销售过相应数量的商品
            
            sqlstr = "SELECT SellDetail_1.FWaresCode, SellDetail_1.FQuantity,  SellDetail.FQuantity  as FSellQuantity" & _
                     " FROM SellDetail AS SellDetail_1 inner JOIN SellDetail ON (SellDetail.FWaresCode = SellDetail_1.FWaresCode) " & _
                     " where SellDetail_1.ftype =" & REDSELL_INVOICE & " and SellDetail.ftype =" & SELL_INVOICE & " and SellDetail.FNo='" & !FSellNo & "' and SellDetail_1.FNo='" & !FNo & "' and -SellDetail_1.FQuantity+ SellDetail.FQuantity<0"

            Rs.Open sqlstr, m_gDBCnn, adOpenStatic, adLockReadOnly
            If Not (Rs.EOF And Rs.BOF) Then
                promptstr = "在相应销售单没有销售过足够数量的下列商品 " & vbCr
                promptstr = promptstr & "商品代码　　　退回数量　　销售数量" & vbCr
                Do While Not Rs.EOF
                     promptstr = promptstr & Rs!FWaresCode & "     " & Abs(Rs!FQuantity) & "          " & Rs!FSellQuantity & vbCr
                     Rs.MoveNext
                 Loop
                 Rs.Close
                 MsgBox promptstr, vbOKOnly + vbInformation, "警告"
                 Exit Sub
            End If
            
        End If
         '如果是销售单或领用单 加上审核数量
        
        If m_byType = SELL_INVOICE Or m_byType = SELFUSE_INVOICE Then
            Dim TempUpdateSql  As String
            Dim nAffectedRecord As Integer
            nAffectedRecord = 0
            TempUpdateSql = "update Balance inner JOIN SellDetail ON (Balance.FWaresCode = SellDetail.FWaresCode) AND (Balance.FHouseCode = SellDetail.FHouseCode) " & _
              " set Balance.FAuditQuantity = Balance.FAuditQuantity + SellDetail.FQuantity " & _
             " where SellDetail.FYear=" & !FYear & " and  SellDetail.FMonth=" & !FMonth & " and  SellDetail.FType  =" & !FType & " and  SellDetail.FNo  ='" & !FNo & "'"
            m_gDBCnn.BeginTrans
                m_gDBCnn.Execute TempUpdateSql, nAffectedRecord
                If nAffectedRecord > 0 Then
                    m_gDBCnn.CommitTrans
                Else
                    m_gDBCnn.RollbackTrans
                    MsgBox "审核出错!,请与供应商联系"
                    Exit Sub
                End If
        End If

        '审核通过，记下审核人
Check_Pass:
        ![FAuditer] = m_gsOperator
    Else
        If m_byType = SELL_INVOICE Or m_byType = SELFUSE_INVOICE Then
'            Dim TempUpdateSql  As String
'            Dim nAffectedRecord As Integer
            nAffectedRecord = 0
            TempUpdateSql = "update Balance inner JOIN SellDetail ON (Balance.FWaresCode = SellDetail.FWaresCode) AND (Balance.FHouseCode = SellDetail.FHouseCode) " & _
              " set Balance.FAuditQuantity = Balance.FAuditQuantity - SellDetail.FQuantity " & _
             " where SellDetail.FYear=" & !FYear & " and  SellDetail.FMonth=" & !FMonth & " and  SellDetail.FType  =" & !FType & " and  SellDetail.FNo  ='" & !FNo & "'"
            m_gDBCnn.BeginTrans
                m_gDBCnn.Execute TempUpdateSql, nAffectedRecord
                If nAffectedRecord > 0 Then
                    m_gDBCnn.CommitTrans
                Else
                    m_gDBCnn.RollbackTrans
                    MsgBox "审核出错!,请与供应商联系"
                    Exit Sub
                End If
        End If
        ![FAuditer] = ""
    End If
    .Update
End With
SetButtons (True)
End Sub
'商品销售发票的记帐: 按商品种类?库房生成出库单?
'若库房为自有库，则出库单不审核，制单人为当前操作员；
'若库房为外库，则出库单为审核且记帐，减少库存商品结存表的期末数，
'填写库存商品明细帐，审核人、记帐人均为当前操作员。
Private Sub cmdKeeper_Click()   '记帐
    Dim sHouseCode As String, nAttrib As Integer, nPriceMode As Integer
    Dim sNewNo As String, sFields As String, sValues As String
    Dim nAffected As Integer
    Dim arrayWaresOutNo() As String
    Dim arrayCount As Long
    arrayCount = 0
    ReDim Preserve arrayWaresOutNo(arrayCount)
   ' On Error GoTo RollBack_ERROR
    
    With adoPrimaryRs
        If Not (IsNull(![FKeeper]) Or ![FKeeper] = "") Then  '已记帐
            Exit Sub
        End If
        '生成出库单

        Dim Rs As ADODB.Recordset
        Dim sSqlStr As String
        Dim bSuccess As Boolean
        Set Rs = New ADODB.Recordset
        sSqlStr = "Select SellDetail.FWaresCode, WaresList.FName, WaresList.FSpecName, WaresList.FMeasurement, FQuantity, FPrice, FMoney, FTaxRate, FTaxMoney,warehouse.FHouseAttrib,SellDetail.FHousecode,wareslist.FPriceMode, FYear, FMonth, FType, FNo " & _
            " From (SellDetail Inner Join WaresList On SellDetail.FWaresCode = WaresList.FWaresCode) left join WareHouse on  SellDetail.FHousecode =warehouse.Fhousecode" & _
            " Where FYear = " & !FYear & " And FMonth = " & !FMonth & " And FType = " & !FType & " And FNo = '" & !FNo & "' Order by SellDetail.FHouseCode,wareslist.FPriceMode,SellDetail.FWaresCode"
        Rs.Open sSqlStr, m_gDBCnn, adOpenDynamic, adLockReadOnly
                 
        m_gDBCnn.BeginTrans
        nAttrib = -1
        nPriceMode = -1
        sHouseCode = ""
        
        Do While Not Rs.EOF
            
            If sHouseCode <> Rs!FHouseCode Then
               sHouseCode = Rs!FHouseCode
               nPriceMode = Rs!FPriceMode
               sNewNo = GetNewInvoiceNo("Select Max(FNo) From WaresOut Where FType = " & IIf(m_byType = REDSELL_INVOICE, OUT_RED, OUT_SELL), 0)
               nAttrib = Rs!FHouseAttrib
               bSuccess = AddWaresOut(nAttrib, m_gnYear, m_gbyMonth, sNewNo, sHouseCode, !FNo)
               If Not bSuccess Then GoTo RollBack_ERROR
               If nAttrib = OUTER_HOUSE Then
                    ReDim Preserve arrayWaresOutNo(arrayCount)
                    arrayWaresOutNo(arrayCount) = sNewNo
                    arrayCount = arrayCount + 1
               End If
            Else
                If nPriceMode <> Rs!FPriceMode Then
                    nPriceMode = Rs!FPriceMode
                    sNewNo = GetNewInvoiceNo("Select Max(FNo) From WaresOut Where FType = " & IIf(m_byType = REDSELL_INVOICE, OUT_RED, OUT_SELL), 0)
                    nAttrib = Rs!FHouseAttrib
                    bSuccess = AddWaresOut(nAttrib, m_gnYear, m_gbyMonth, sNewNo, sHouseCode, !FNo)
                    If Not bSuccess Then GoTo RollBack_ERROR
                    If nAttrib = OUTER_HOUSE Then
                        ReDim Preserve arrayWaresOutNo(arrayCount)
                        arrayWaresOutNo(arrayCount) = sNewNo
                        arrayCount = arrayCount + 1
                    End If
                End If
            End If
            '填写出库单
            
            bSuccess = AddWaresOutDetail(nAttrib, m_gnYear, m_gbyMonth, sNewNo, Rs!FWaresCode, Rs!FQuantity, Rs!FPrice, Rs!FMoney, Rs!FPriceMode, Rs!FHouseCode)
            If Not bSuccess Then GoTo RollBack_ERROR
            Rs.MoveNext
        Loop
        
        
        '对出库单中的外库出库单记帐 FDate  Fmonth  Fyear FType FNo
        If m_byType <> REDSELL_INVOICE Then
            If arrayCount > 0 Then
                Dim i As Integer
                For i = 0 To arrayCount - 1
                    bSuccess = Keep_Business_Records(m_gnYear, m_gbyMonth, IIf(m_byType = REDSELL_INVOICE, OUT_RED, OUT_SELL), arrayWaresOutNo(i))
                    If Not bSuccess Then GoTo RollBack_ERROR
              
                Next i
            End If
        End If
        ![FKeeper] = m_gsOperator
        .Update
        
        m_gDBCnn.CommitTrans
        
    End With
    SetButtons (True)
    Exit Sub
    
RollBack_ERROR:
    m_gDBCnn.RollbackTrans
    MsgBox "数据共享冲突, 记帐不成功!", vbOKOnly + vbExclamation, "提示:"
    adoPrimaryRs![FKeeper] = ""
    adoPrimaryRs.Update
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

'////////////////////////////////////////////////
'//
Private Sub cmdFirst_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = 1 Then Exit Sub  '已是首记录
        .MoveFirst
    End With
    SetButtons (True)
End Sub

Private Sub cmdLast_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = .RecordCount Then Exit Sub    '已是尾记录
        .MoveLast
    End With
    SetButtons (True)
End Sub

Private Sub cmdNext_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = .RecordCount Then Exit Sub    '已是尾记录
        .MoveNext
    End With
    SetButtons (True)
End Sub

Private Sub cmdPrevious_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = 1 Then Exit Sub   '已是首记录
        .MovePrevious
    End With
    SetButtons (True)
End Sub

'///////////////////////////////////////////////////
'//
Private Sub SetButtons(bVal As Boolean)
    Dim bAuditer As Boolean, bKeeper As Boolean, bEmpty As Boolean
    With adoPrimaryRs
        If .EOF Or .BOF Then
            bAuditer = True
            bKeeper = True
            bEmpty = True
        Else
            bAuditer = IIf(IsNull(![FAuditer]) Or ![FAuditer] = "", False, True) '未审核/审核
            bKeeper = IIf(IsNull(![FKeeper]) Or ![FKeeper] = "", False, True)    '未记帐/记帐
            bEmpty = False
        End If
    End With
    
    dacDepart.Enabled = Not bVal
    DACCustomer.Enabled = Not bVal
    maskDate.Enabled = Not bVal
    txtNo.Enabled = Not bVal
    txtSellNo.Enabled = Not bVal
    txtCheque.Enabled = Not bVal
    
    txtHandler.Enabled = Not bVal
    txtKeeper.Enabled = False
    txtAuditer.Enabled = False
    txtMaker.Enabled = False
    txtFindNo.Enabled = bVal And Not bEmpty
    
    grdDataGrid.AllowUpdate = Not bVal
    
    cmdAdd.Enabled = bVal And m_bEdit
    cmdEdit.Enabled = bVal And Not bAuditer And m_bEdit
    cmdUpdate.Visible = Not bVal
    cmdDelete.Enabled = bVal And Not bAuditer And m_bEdit
    cmdPrint.Enabled = bVal And Not bEmpty And bAuditer
    cmdClose.Enabled = bVal
    
    cmdFirst.Enabled = bVal
    cmdLast.Enabled = bVal
    cmdPrevious.Enabled = bVal
    cmdNext.Enabled = bVal
    
    cmdAuditer.Enabled = bVal And Not bKeeper And m_bAuditer
    cmdKeeper.Enabled = bVal And bAuditer And Not bKeeper And m_bKeeper
    
    cmdAuditer.Caption = IIf(Not bKeeper And bAuditer And m_bAuditer, "弃审", "审核")
End Sub

'////////////////////////////////////////////////////
'//
Private Sub grdDataGrid_AfterColUpdate(ByVal ColIndex As Integer)
    With grdDataGrid
        If ColIndex = CodeCol Then
            If m_sWaresCode <> "" Then
                .Columns(YearCol).Text = adoPrimaryRs![FYear]
                .Columns(MonthCol).Text = adoPrimaryRs![FMonth]
                .Columns(TypeCol).Text = adoPrimaryRs![FType]
                .Columns(NoCol).Text = adoPrimaryRs![FNo]
                '.Columns(HouseCodeCol) = "1" & Mid(m_sWaresCode, 3, 1) 'lzlz
                .Text = m_sWaresCode
                
                adoSecondaryRs.Update
                .Col = MeasCol
            End If
            
        ElseIf ColIndex = QuantityCol Or ColIndex = PriceCol Then
            .Columns(MoneyCol).Text = Format(Val(.Columns(QuantityCol).Text) * Val(.Columns(PriceCol).Text), MoneyFormat())
            .Columns(TaxCol).Text = Format(Val(.Columns(MoneyCol).Text) * GetTaxRate(.Columns(RateCol).Text), MoneyFormat())
            If ColIndex = PriceCol Then .Col = MoneyCol
            
        ElseIf ColIndex = MoneyCol Then
            If Val(.Columns(QuantityCol).Text) = 0 Then
                .Columns(PriceCol).Text = 0
            Else
                .Columns(PriceCol).Text = Format(Val(.Columns(MoneyCol).Text) / Val(.Columns(QuantityCol).Text), PriceFormat())
            End If
            .Columns(TaxCol).Text = Format(Val(.Columns(MoneyCol).Text) * GetTaxRate(.Columns(RateCol).Text), MoneyFormat())
            
        ElseIf ColIndex = RateCol Then
            .Columns(TaxCol).Text = Format(Val(.Columns(MoneyCol).Text) * GetTaxRate(.Columns(RateCol).Text), MoneyFormat())
            .Col = TaxCol
            
        ElseIf ColIndex = TaxCol Then
            If Val(.Columns(MoneyCol).Text) = 0 Then
                .Columns(RateCol).Text = 0
            Else
                .Columns(RateCol).Text = Val(.Columns(TaxCol).Text) / Val(.Columns(MoneyCol).Text)
            End If
        End If
    End With
End Sub