frmwaressell.frm

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

    Next
    Set dacDepart.DataSource = adoPrimaryRs
    Set DACCustomer.DataSource = adoPrimaryRs
End Sub

Private Sub RefreshDataGrid(nYear As Integer, byMonth As Byte, byType As Byte, sNo As String)
    Dim sSqlStr As String
    Dim sGrdWidth As String, i As Integer, j As Integer
    
    Set adoSecondaryRs = Nothing
    Set adoSecondaryRs = New ADODB.Recordset
    With adoSecondaryRs
        sSqlStr = "Select SellDetail.FWaresCode, WaresList.FName, WaresList.FSpecName, WaresList.FMeasurement, FQuantity, FPrice, FMoney, FTaxRate, FTaxMoney,warehouse.FHouseName,SellDetail.FHousecode, FYear, FMonth, FType, FNo " & _
            " From (SellDetail Inner Join WaresList On SellDetail.FWaresCode = WaresList.FWaresCode) left join WareHouse on  SellDetail.FHousecode =warehouse.Fhousecode" & _
            " Where FYear = " & nYear & " And FMonth = " & byMonth & " And FType = " & byType & " And FNo = '" & sNo & "' Order by SellDetail.FWaresCode"
        .Open sSqlStr, m_gDBCnn, adOpenDynamic, adLockOptimistic, adCmdUnknown
        .Properties("Unique Table") = "SellDetail"
        .Properties("Resync Command") = "SELECT * FROM (" & sSqlStr & ") WHERE FWaresCode = ? And FYear = ? And FMonth = ? And FType = ? And FNo = ?"
        .Properties("Update Resync") = adResyncAll Or adResyncUpdates Or adResyncInserts Or adResyncConflicts
    End With
    
    With grdDataGrid
        Set .DataSource = adoSecondaryRs
        sGrdWidth = GetPrivateSetting(Me.Caption, "GrdWidth", "")
        .RowHeight = GetPrivateSetting(Me.Caption, "GrdHeight", "275")
        
        i = 0
        .Columns(i).Caption = "商品编码"
        SetColumnWidth sGrdWidth, .Columns(i), 1200
        .Columns(i).Button = True
        CodeCol = i
        i = i + 1
        .Columns(i).Caption = "名称"
        SetColumnWidth sGrdWidth, .Columns(i), 1500
        .Columns(i).Locked = True
        NameCol = i
        i = i + 1
        .Columns(i).Caption = "规格"
        SetColumnWidth sGrdWidth, .Columns(i), 1200
        .Columns(i).Locked = True
        SpecCol = i
        i = i + 1
        .Columns(i).Caption = "计量单位"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        .Columns(i).Locked = True
        MeasCol = i
        i = i + 1
        .Columns(i).Caption = "销售数量"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        QuantityCol = i
        i = i + 1
        .Columns(i).Caption = "单价"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        PriceCol = i
        i = i + 1
        .Columns(i).Caption = "金额"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        .Columns(i).NumberFormat = MoneyFormat()
        MoneyCol = i
        i = i + 1
        .Columns(i).Caption = "税率%"
        SetColumnWidth sGrdWidth, .Columns(i), 750
        .Columns(i).NumberFormat = "##0.00%"
        RateCol = i
        i = i + 1
        .Columns(i).Caption = "税额"
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        .Columns(i).NumberFormat = MoneyFormat()
        TaxCol = i
        i = i + 1
        
        .Columns(i).Caption = IIf(m_byType = REDSELL_INVOICE, "退回库房", "库房")
        SetColumnWidth sGrdWidth, .Columns(i), 1000
        .Columns(i).Button = True
        HouseCol = i
        
        For j = i + 1 To i + 5  'FHouseCode,FYear, FMonth, FType, FNo
            .Columns(j).Visible = False
            .Columns(j).AllowSizing = False
            .Columns(j).Locked = True
            SetColumnWidth sGrdWidth, .Columns(j), 0
        Next
        HouseCodeCol = i + 1
        YearCol = i + 2
        MonthCol = i + 3
        TypeCol = i + 4
        NoCol = i + 5
    End With
End Sub

Private Sub adoPrimaryRs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim nYear As Integer, byMonth As Byte, byType As Byte
    
    With adoPrimaryRs
        If .EOF Or .BOF Or IsNull(![FNo]) Then
            txtNo.Text = ""
            maskDate.Text = "____年__月__日"
            lblAddressTel.Caption = ""
            lblStatus.Caption = ""
        Else
            nYear = ![FYear]
            byMonth = ![FMonth]
            byType = ![FType]
            txtNo.Text = ![FNo]
            If m_byType = REDSELL_INVOICE Then txtSellNo.Text = IIf(IsNull(!FSellNo), "", !FSellNo)
            
            maskDate.Text = Format(![FDate], "YYYY年MM月DD日")
            lblAddressTel.Caption = IIf(IsNull(![FAddress]), "", ![FAddress]) & "," & IIf(IsNull(![FTel]), "", ![FTel])
            lblStatus.Caption = "序号: " & CStr(adoPrimaryRs.AbsolutePosition)
        End If
    End With
    
    RefreshDataGrid nYear, byMonth, byType, txtNo.Text
End Sub

Private Sub adoPrimaryRs_Error(ByVal ErrorNumber As Long, Description As String, ByVal sCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
'    MsgBox "Data error event hit err:" & Description
    fCancelDisplay = True
End Sub

Private Sub adoPrimaryRs_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    '验证代码置于此处
    '下列动作发生时该事件被调用
    Dim bCancel As Boolean
    
    Select Case adReason
    Case adRsnAddNew
    Case adRsnClose
    Case adRsnDelete
    Case adRsnFirstChange
    Case adRsnMove
    Case adRsnRequery
    Case adRsnResynch
    Case adRsnUndoAddNew
    Case adRsnUndoDelete
    Case adRsnUndoUpdate
    Case adRsnUpdate
    End Select
    
    If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Form_Load()
    SetForm Me, 9
    InitScreenObject
    
    Dim sSqlStr As String
    Set adoPrimaryRs = New ADODB.Recordset
    With adoPrimaryRs
        sSqlStr = "SELECT Sell.FYear, Sell.FMonth, Sell.FType, Sell.FNo, Sell.FDate, Sell.FDepartCode, Sell.FCustomerCode,sell.FSellno, Customer.FAddress, Customer.FTel, Sell.FChequeNo, Sell.FHandler, Sell.FKeeper, Sell.FAuditer, Sell.FMaker " & _
            " FROM Customer left JOIN Sell ON Customer.FCustomerCode = Sell.FCustomerCode " & _
            " Where FYear = " & m_gnYear & " And FMonth = " & m_gbyMonth & " And FType = " & m_byType & " Order by val(FNo)"
        .Open sSqlStr, m_gDBCnn, adOpenDynamic, adLockOptimistic, adCmdUnknown
        .Properties("Unique Table") = "Sell"
        .Properties("Resync Command") = "SELECT * FROM (" & sSqlStr & ") WHERE FYear = ? And FMonth = ? And FType = ? And FNo = ?"
        .Properties("Update Resync") = adResyncAll Or adResyncUpdates Or adResyncInserts Or adResyncConflicts
        If Not (.EOF And .BOF) Then .MoveLast
    End With
    
    BoundingScreenObject
    SetButtons (True)
    m_bIsSelectWares = False
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    '当窗体调整时会调整网格
    lblTitle(0).Left = (Me.ScaleWidth - lblTitle(0).Width) / 2
    lblTitle(1).Left = lblTitle(0).Left + 30
    Me.lblbackColor.Width = Me.ScaleWidth
    With grdDataGrid
        .Left = 50
        .Width = Me.ScaleWidth - .Left * 2
        .Height = Me.ScaleHeight - .Top - picButtons.Height - picStatBox.Height
    End With
    
    txtFindNo.Left = Me.ScaleWidth - txtFindNo.Width - 50
    lblFindNo.Left = txtFindNo.Left - lblFindNo.Width - 50
    
    cmdLast.Left = lblFindNo.Left - 340 - 300
    cmdNext.Left = cmdLast.Left - 340
    
    lblStatus.Width = cmdNext.Left - lblStatus.Left - 20
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Screen.MousePointer = vbDefault
End Sub

'///////////////////////////////////////////////////
'//
Private Sub cmdAdd_Click()
    With adoPrimaryRs
        .AddNew
        cmdUpdate.Left = cmdAdd.Left
        lblStatus.Caption = "添加单据"
        SetButtons (False)
        ![FYear] = m_gnYear
        ![FMonth] = m_gbyMonth
        ![FType] = m_byType
        maskDate.Text = Format(m_gLoginDate, "YYYY年MM月DD日")
        txtMaker.Text = m_gsOperator
        txtNo.Text = GetNextNo
        dacDepart.SetFocus
    End With
End Sub

Private Sub cmdDelete_Click()
    Dim nRet As Integer
    
    With adoPrimaryRs
        If .EOF Or .BOF Then
            Exit Sub
        End If
        
        nRet = MsgBox("您真的要删除当前单据吗？", vbQuestion + vbYesNo + vbDefaultButton2, "提示：")
        If nRet = vbYes Then
            '先删除单据明细
            m_gDBCnn.Execute "Delete * From SellDetail Where FYear = " & ![FYear] & " And FMonth = " & ![FMonth] & " And FType = " & ![FType] & " And FNo = '" & ![FNo] & "'"
            '再删除单据头
            .Delete
            .MoveNext
            If .EOF And .RecordCount > 0 Then .MoveLast
        End If
    End With
    
    SetButtons (True)
End Sub

Private Sub cmdEdit_Click()
    If adoPrimaryRs.EOF Or adoPrimaryRs.BOF Then Exit Sub
    
    cmdUpdate.Left = cmdEdit.Left
    lblStatus.Caption = "修改单据"
    SetButtons (False)
    dacDepart.SetFocus
End Sub

Private Function UpdateInvoice() As Boolean
    On Error GoTo UpdateErr
    
    With adoPrimaryRs
        If Not CheckDataValidity() Then
            UpdateInvoice = False
            Exit Function
        End If
        
        m_gDBCnn.BeginTrans
        If txtNo.Text <> ![FNo] Or IsNull(![FNo]) Then     '单据号改变, 连锁更新单据明细
            m_gDBCnn.Execute "Update SellDetail Set FNo = '" & txtNo.Text & "' Where FYear = " & ![FYear] & " And FMonth = " & ![FMonth] & " And FType = " & ![FType] & " And FNo = '" & ![FNo] & "'"
            RefreshDataGrid ![FYear], ![FMonth], ![FType], txtNo.Text
        End If
        ![FNo] = txtNo.Text
        ![FSellNo] = txtSellNo.Text
        ![FDate] = maskDate.Text
        
        .Update
        m_gDBCnn.CommitTrans
    End With
    
    UpdateInvoice = True
    Exit Function
    
UpdateErr:
    m_gDBCnn.RollbackTrans
    MsgBox "数据输入有误, 请修改!", vbOKOnly + vbExclamation, "提示："
    UpdateInvoice = False
    dacDepart.SetFocus
End Function

Private Sub cmdUpdate_Click()
    If UpdateInvoice() Then
        lblStatus.Caption = "序号: " & CStr(adoPrimaryRs.AbsolutePosition)
        SetButtons (True)
    End If
End Sub

Private Sub cmdAuditer_Click()
'检查是否有该商品，以及该商品的数量是否够
Dim sqlstr As String, promptstr As String
With adoPrimaryRs
    If IsNull(![FAuditer]) Or ![FAuditer] = "" Then     '未审核
        '检查网格记录是否为空
        If adoSecondaryRs.EOF And adoSecondaryRs.BOF Then
            MsgBox "没有销售明细，请先输入要销售的商品!"
            Exit Sub
        End If
        
        Dim Rs As ADODB.Recordset
        Set Rs = New ADODB.Recordset
        
        '检查记录中是否有金额和数量为0的情况
        sqlstr = "select FWaresCode from selldetail " & _
        " where SellDetail.FYear=" & !FYear & " and  SellDetail.FMonth=" & !FMonth & " and  SellDetail.FType  =" & !FType & " and  SellDetail.FNo  ='" & !FNo & "'"
        
        sqlstr = sqlstr + " and (FQuantity <=0 or FMoney<=0)"
        
        Rs.Open sqlstr, m_gDBCnn, adOpenDynamic, adLockReadOnly
        If Not (Rs.EOF And Rs.BOF) Then
            promptstr = "下列商品的数量或金额为<=0 " & vbCr
            
            Do While Not Rs.EOF
                promptstr = promptstr & Rs!FWaresCode & vbCr
                Rs.MoveNext
            Loop
            Rs.Close
            MsgBox promptstr
            Exit Sub
        End If
        Rs.Close
        '检查商品在相应库房是否有足够数量
         Dim TempRs As ADODB.Recordset
            Set TempRs = adoSecondaryRs.Clone
            
            TempRs.Filter = "FHouseCode ='' or FHouseCode =null "
            If Not (TempRs.EOF And TempRs.BOF) Then
                 promptstr = "下列商品没有指定退回库房" & vbCr
                 Do While Not TempRs.EOF
                     promptstr = promptstr & TempRs!FWaresCode & vbCr
                     TempRs.MoveNext
                 Loop
                 TempRs.Close
                 MsgBox promptstr, vbOKOnly + vbInformation, "警告"
                 Exit Sub
             End If
             TempRs.Close
        If m_byType <> REDSELL_INVOICE Then '退货不用检查数量 , 检查是否卖过这种商品
        
             sqlstr = "SELECT SellDetail.FWaresCode,SellDetail.FQuantity, Balance.FQuantity, Balance.FReferencedQuantity "
             sqlstr = sqlstr & "FROM SellDetail left JOIN Balance ON (Balance.FWaresCode = SellDetail.FWaresCode) AND (Balance.FHouseCode = SellDetail.FHouseCode) "
             sqlstr = sqlstr & "WHERE ((SellDetail.FQuantity)>([Balance].[FQuantity]-[Balance].[FReferencedQuantity]-[Balance].[FAuditQuantity])) " & _
             " and SellDetail.FYear=" & !FYear & " and  SellDetail.FMonth=" & !FMonth & " and  SellDetail.FType  =" & !FType & " and  SellDetail.FNo  ='" & !FNo & "'"
             
            
             Rs.Open sqlstr, m_gDBCnn, adOpenDynamic, adLockReadOnly
             If Not (Rs.EOF And Rs.BOF) Then