frmselledit.frm

一个简单但功能强大的进货系统,同样适合用于毕业论文的设计

                End If
                .CancelBatch
                Call IsEdit(False)
                rsSeAdd.Filter = "出库编号='" & Me.txtSell_id.Text & "'"
                
            Case 2
                rsSeAdd.AddNew "出库编号", Me.txtSell_id.Text
                rsSeAdd.Filter = "出库编号='" & Me.txtSell_id.Text & "'"
                rsSeAdd.MoveLast
                Me.DataGrid2.Col = 1
                Call IsEdit(True)
                Call Txtgrid2_Leave
                
            Case 3
                If rsSeAdd.RecordCount <> 0 Then
                    rsSeAdd.Delete
                End If
                If rsSeAdd.RecordCount <> 0 Then
                    rsSeAdd.MoveFirst
                    Me.DataGrid2.Col = 1
                    Call IsEdit(True)
                    Call Txtgrid2_Leave
                End If
        End Select
    End With
    

End Sub

Private Sub CmdDep_Click(Index As Integer)
    
    Dim intNum As Integer
    Dim strSQL As String
    
    Select Case Index
    
        Case 0
            Call AddNew
            
        Case 1
            Call IsEdit(True)
            Me.txtSell_id.SetFocus
            With rsSeAdd
                If .RecordCount <> 0 Then
                    .MoveFirst
                    Me.DataGrid2.Col = 1
                    Call Txtgrid2_Leave
                End If
            End With
            
            
        Case 2
        
        Case 3
            intNum = MsgBox("确认删除当前记录吗?", vbYesNo + vbQuestion, "删除确认")
            If intNum = vbYes Then
                With rsSeEdit
                    strSQL = "delete from 出库表_tmp where 出库编号='" & Me.txtSell_id.Text & "'"
                    cmdSeEdit.CommandText = strSQL
                    cmdSeEdit.Execute
                    .Delete
                    .UpdateBatch
                    If .RecordCount <> 0 Then
                        .MoveFirst
                    End If
                    rsSeAdd.Filter = "出库编号 ='" & Me.txtSell_id.Text & "'"
                End With
            End If

        Case 4
        
        Case 5
            Unload Me
    End Select
    
    
End Sub

Private Sub DataGrid2_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    If CmdDep(2).Enabled = True Then
        LblStatus.Caption = Product_Status(DataGrid2.Columns(1).Text)
    End If
End Sub

Private Sub Form_Load()
    
    Set rsSeEdit = DEaccp.rsCom销售出库信息
    Set rsSeAdd = DEaccp.rsCom出库
    Set cmdSeEdit = New Command
    
    cmdSeEdit.ActiveConnection = DEaccp.Conaccp
    cmdSeEdit.CommandType = adCmdText
    rsSeAdd.Filter = "出库编号='" & Me.txtSell_id.Text & "'"
    Me.LblStatus.Caption = "提示:当增加商品时按下[F2]查询商品编号"
    Call IsEdit(False)
    
End Sub

Private Sub IsEdit(blnIsEdit As Boolean)
    
    Dim intNum As Integer
    
    Me.DCSell_type.Enabled = blnIsEdit
    Me.txtSell_id.Enabled = blnIsEdit
    Me.txtSell_date.Enabled = blnIsEdit
    Me.DCserve.Enabled = blnIsEdit
    Me.DCCl.Enabled = blnIsEdit
    Me.txtinfo.Enabled = blnIsEdit
    If rsSeAdd.RecordCount <> 0 Then
        Me.Txtgrid2.Visible = blnIsEdit
    Else
        Me.Txtgrid2.Visible = False
    End If
    For intNum = 0 To 3
        Me.CmdAct(intNum).Enabled = blnIsEdit
    Next
    For intNum = 0 To 5
        Me.CmdDep(intNum).Enabled = Not blnIsEdit
    Next
'    If Me.txtOther_id.Text = "" Then
'        For intNum = 2 To 3
'            Me.CmdAct(intNum).Enabled = False
'        Next
'    End If
    If rsSeEdit.RecordCount = 0 Then
        For intNum = 1 To 4
            Me.CmdDep(intNum).Enabled = False
        Next
    End If

    
End Sub

Private Sub AddNew()
    
    With rsSeEdit
        .AddNew
        rsSeAdd.Filter = "出库编号='" & Me.txtSell_id & "'"
        Call IsEdit(True)
        Me.txtSell_date.Text = CStr(dteSysDate)
        Me.txtname.Text = user
        Me.DCSell_type.SetFocus
    End With
    
End Sub



Private Sub Txtgrid2_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF2
            If DataGrid2.Col = 1 Then
                frmFindPro.SQLFindPro = Txtgrid2.Text
                frmFindPro.Show vbModal
                If frmFindPro.SQLFindPro <> "" Then
                    Txtgrid2.Text = frmFindPro.SQLFindPro
                    DataGrid2.Columns(1).Text = Txtgrid2.Text
                End If
            End If
        Case vbKeyReturn
            Call Column_value
            Call Cal_Price
            Call ColToRight
            Call Txtgrid2_Leave
        Case vbKeyLeft
            Call Column_value
            Call Cal_Price
            Call ColToLeft
            Call Txtgrid2_Leave
        Case vbKeyRight
            Call Column_value
            Call Cal_Price
            Call ColToRight
            Call Txtgrid2_Leave
        Case vbKeyUp
            Call Column_value
            Call Cal_Price
            Call RowToUp
            Call Txtgrid2_Leave
        Case vbKeyDown
            Call Column_value
            Call Cal_Price
            Call RowToDown
            Call Txtgrid2_Leave
    End Select
    
End Sub

Private Sub Txtgrid2_KeyPress(KeyAscii As Integer)
    Dim strValid As String
    If DataGrid2.Col = 2 Or DataGrid2.Col = 3 Then
        strValid = "0123456789."
        If KeyAscii > 26 Then
            If InStr(strValid, Chr(KeyAscii)) = 0 Then
                KeyAscii = 0
            End If
        End If
    End If
End Sub
Private Sub Txtgrid2_Leave()
With Me.DataGrid2
    If .Columns(1).Text <> "" Then
        LblStatus.Caption = Product_Status(.Columns(1).Text)
        If .Columns(3).Text <> "" Then
            If Not SaleTooLarge(.Columns(0).Text, .Columns(1).Text, .Columns(3).Text) Then
                MsgBox "出库量大于库存量!", vbCritical, "错误"
            End If
        End If
    Else
        LblStatus.Caption = ""
    End If
End With
    Txtgrid2.Text = DataGrid2.Columns(DataGrid2.Col).Text
    Txtgrid2.SelStart = 0
    Txtgrid2.SelLength = Len(Txtgrid2.Text)
    Txtgrid2.Width = DataGrid2.Columns(DataGrid2.Col).Width
    Txtgrid2.Left = DataGrid2.Left + DataGrid2.Columns(DataGrid2.Col).Left
    Txtgrid2.Top = DataGrid2.Top + DataGrid2.Row * DataGrid2.RowHeight + 225
    Txtgrid2.SetFocus
End Sub

Private Sub ColToRight()
    If DataGrid2.Col < DataGrid2.Columns.Count - 2 Then
        DataGrid2.Col = DataGrid2.Col + 1
    Else
        Call RowToDown
        DataGrid2.Col = 1
    End If
End Sub

Private Sub ColToLeft()
    If DataGrid2.Col > 1 Then
        DataGrid2.Col = DataGrid2.Col - 1
    End If
End Sub

Private Sub RowToUp()
    With rsSeAdd
        If Not .BOF Then
            .MovePrevious
        End If
        If .BOF Then .MoveNext
    End With
End Sub

Private Sub RowToDown()
    With rsSeAdd
        If Not .EOF Then
            .MoveNext
        End If
        If .EOF Then .MovePrevious
    End With
End Sub

Private Sub Cal_Price()
    With DataGrid2
        If .Columns(2).Text <> "" And .Columns(3).Text <> "" Then
            .Columns(4).Value = Sale_Price(.Columns(0).Text, .Columns(1).Text, .Columns(2).Text, .Columns(3).Text)
        End If
    End With
End Sub
Private Sub Column_value()
    With DataGrid2
        If .Col = 2 Then
           .Columns(.Col).Text = CStr(SaleUnPr(.Columns(0).Text, .Columns(1).Text))
        ElseIf .Col = 3 Then
            If Txtgrid2.Text <> "" Then .Columns(.Col).Text = CStr(Round(CCur(Txtgrid2.Text), 2))
            For i = 2 To 3
                Me.CmdAct(i).Enabled = True
            Next
        Else
            .Columns(.Col).Text = Txtgrid2.Text
        End If
    End With
End Sub

Private Function Save() As Boolean
    
    If IsNull(Me.DCSell_type.SelectedItem) Or Trim(Me.DCSell_type.Text) = "" Then
        MsgBox "请选择单据类型!", vbOKOnly + vbCritical, "错误"
        Me.DCSell_type.SetFocus
        Save = False
        Exit Function
    End If
    
    If Trim(Me.txtSell_id.Text) = "" Then
        MsgBox "入库编号不能为空!", vbOKOnly + vbCritical, "错误"
        Me.txtSell_id.SetFocus
        Save = False
        Exit Function
    End If
    
    If Me.txtSell_date.Text = "" Or (Not IsDate(Me.txtSell_date.Text)) Then
        MsgBox "日期格式错误!", vbOKOnly + vbCritical, "错误"
        Me.txtSell_date.SetFocus
        SaveValid = False
        Exit Function
    End If
    
    If IsNull(Me.DCserve.SelectedItem) Then
        MsgBox "请选择供应商!", vbOKOnly + vbCritical, "错误"
        Me.DCserve.SetFocus
        Save = False
        Exit Function
    End If
    
    If IsNull(Me.DCCl.SelectedItem) Then
        MsgBox "请选择客户!", vbOKOnly + vbCritical, "错误"
        Me.DCCl.SetFocus
        Save = False
        Exit Function
    End If
    
    If rsSeAdd.RecordCount = 0 Then
        MsgBox "单据明细项不能为空!", vbOKOnly + vbCritical, "错误"
        Save = False
        Exit Function
    End If
    Save = True
    
End Function