frmsaleorderinsert.frm

来自「很好！ 很实用！ 免费！」· FRM 代码 · 共 511 行 · 第 1/2 页

      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "地址"
         Height          =   195
         Left            =   120
         TabIndex        =   8
         Top             =   1440
         Width           =   360
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "客户"
         Height          =   195
         Left            =   3480
         TabIndex        =   7
         Top             =   360
         Width           =   360
      End
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "Apply"
      Height          =   375
      Left            =   8670
      TabIndex        =   2
      Top             =   6480
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   7470
      TabIndex        =   1
      Top             =   6480
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   6240
      TabIndex        =   0
      Top             =   6480
      Width           =   1095
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      Caption         =   "数量"
      Height          =   195
      Left            =   5280
      TabIndex        =   24
      Top             =   3120
      Width           =   360
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      Caption         =   "单价"
      Height          =   195
      Left            =   3360
      TabIndex        =   22
      Top             =   3120
      Width           =   360
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "商品"
      Height          =   195
      Left            =   120
      TabIndex        =   5
      Top             =   3120
      Width           =   360
   End
End
Attribute VB_Name = "frmSaleOrderInsert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rsItem As Recordset

Private Sub cmdApply_Click()
    If SaveData() Then
        MsgBox "OK"
    Else
    
    End If

End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdDel_Click()
'On Error GoTo errhwnd
    If rsItem.RecordCount = 0 Then Exit Sub
    With rsItem
        .Delete adAffectCurrent
        .Update
    End With
    
    GoTo errExit
errhwnd:
    MsgBox "new Error!"
    rsItem.CancelUpdate
    GoTo errExit
errExit:
    If rsItem.RecordCount > 0 Then
        rsItem.MoveLast
    End If
End Sub

Private Sub cmdModify_Click()
'On Error GoTo errhwnd
    If rsItem.RecordCount = 0 Then Exit Sub
    With rsItem
        .Fields("ItemID").value = cbCommodity.Item("ID", cbCommodity.ListIndex)
        .Fields("ItemCode").value = cbCommodity.Item("Code", cbCommodity.ListIndex)
        .Fields("ItemName").value = cbCommodity.Item("Item", cbCommodity.ListIndex)
        .Fields("ItemPrice").value = txtPrice.Text
        .Fields("ItemQty").value = txtQty.Text
        .Fields("ItemAmount").value = CDbl(txtPrice.Text) * CDbl(txtQty.Text)
        .Update
    End With
    GoTo errExit
errhwnd:
    MsgBox "new Error!"
    rsItem.CancelUpdate
    GoTo errExit
errExit:


End Sub

Private Sub cmdNew_Click()
'On Error GoTo errhwnd
    With rsItem
        .AddNew
        .Fields("ItemID").value = cbCommodity.Item("ID", cbCommodity.ListIndex)
        .Fields("ItemCode").value = cbCommodity.Item("Code", cbCommodity.ListIndex)
        .Fields("ItemName").value = cbCommodity.Item("Item", cbCommodity.ListIndex)
        .Fields("ItemPrice").value = txtPrice.Text
        .Fields("ItemQty").value = txtQty.Text
        .Fields("ItemAmount").value = CDbl(txtPrice.Text) * CDbl(txtQty.Text)
        .Update
    End With
    PivotTable1.Refresh
    GoTo errExit
errhwnd:
    MsgBox "new Error!"
    rsItem.CancelUpdate
    GoTo errExit
errExit:

End Sub

Private Sub cmdOK_Click()
    If SaveData() Then
        Unload Me
    Else
    End If
End Sub
Private Function SaveData() As Boolean
Dim objOrder As clsOrder
Dim sSQL As String
    SaveData = False
    If rsItem.RecordCount = 0 Then Exit Function
    If Not rsItem.BOF Then rsItem.MoveFirst
    sSQL = ""
    Do While Not rsItem.EOF
        Set objOrder = New clsOrder
        With objOrder
            .m_ID = newGUID
            .m_Address = txtAddress.Text
            .m_OrderStatus = "待审批"
            .m_CommodityID = rsItem.Fields("ItemID").value
            .m_CustomerID = cbCustomer.Item("ID", cbCustomer.ListIndex)
            .m_WarehouseID = cbWarehouse.Item("ID", cbWarehouse.ListIndex)
            .m_Tel = txtTel.Text
            .m_Contactee = txtContactee.Text
            .m_Email = Me.txtEmail.Text
            .m_Fax = Me.txtFax.Text
            .m_Fee = Me.txtFee.Text
            .m_OrderNo = Me.txtOrderNo.Text
            .m_OrderType = "销售订单"
            .m_PAmount = rsItem.Fields("ItemAmount").value
            .m_PQty = rsItem.Fields("ItemQty").value
            .m_Price = rsItem.Fields("ItemPrice").value
            sSQL = sSQL + .Insert()
        End With
        rsItem.MoveNext
    Loop
    If objOrder.BatchSubmit(sSQL) Then
        SaveData = True
        Call frmSaleOrder.RefreshData
    End If

End Function
Private Sub Form_Load()
    'center the form
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
        
    Dim objCustomer As New clsCustomer
    Dim objWarehouse As New clsWarehouse
    Dim objCommodity As New clsCommodity
    
    cbWarehouse.RelativeList objWarehouse.GetList("ID,No,Name", , "No"), "No,Name"
    cbWarehouse.ListIndex = 0
    
    cbCustomer.RelativeList objCustomer.GetList("ID,No,Name", "", "No"), "No,Name"
    cbCustomer.ListIndex = 0
    If frmSaleOrder.sCustID > "" Then
        cbCustomer.SelectItem "ID", frmSaleOrder.sCustID
        cbCustomer.Enabled = False
    End If
    
    cbCommodity.RelativeList objCommodity.GetList("ID,Code,Item", , "Code"), "Item"
    cbCommodity.ListIndex = 0
    
    Set rsItem = New ADODB.Recordset
    rsItem.CursorLocation = adUseClient
    rsItem.Fields.Append "ItemID", adGUID, 16, adFldKeyColumn
    rsItem.Fields.Append "ItemCode", adVarChar, 50
    rsItem.Fields.Append "ItemName", adVarChar, 50
    rsItem.Fields.Append "ItemPrice", adVarChar, 15
    rsItem.Fields.Append "ItemQty", adVarChar, 15
    rsItem.Fields.Append "ItemAmount", adVarChar, 15
    
    rsItem.Open , , 3, 3
    
    PivotTable1.DataSource = rsItem
    
    PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets("ItemCode")
    PivotTable1.ActiveView.DataAxis.FieldSets.Item(0).Fields.Item(0).Caption = "产品编号"
    PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets("ItemName")
    PivotTable1.ActiveView.DataAxis.FieldSets.Item(0).Fields.Item(0).Caption = "产品名称"
    PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets("ItemPrice")
    PivotTable1.ActiveView.DataAxis.FieldSets.Item(1).Fields.Item(0).Caption = "价格"
    PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets("ItemQty")
    PivotTable1.ActiveView.DataAxis.FieldSets.Item(2).Fields.Item(0).Caption = "数量"
    PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets("ItemAmount")
    PivotTable1.ActiveView.DataAxis.FieldSets.Item(3).Fields.Item(0).Caption = "金额"

End Sub

Private Sub PivotTable1_Click()
    If rsItem.RecordCount = 0 Then Exit Sub
    
    cbCommodity.Text = rsItem.Fields("ItemName").value
    txtPrice.Text = rsItem.Fields("ItemPrice").value
    txtQty.Text = rsItem.Fields("ItemQty").value
    
End Sub