frmpurchaseorderinsert.frm

很好！ 很实用！ 免费！

      _ExtentX        =   4895
      _ExtentY        =   556
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      FontSize        =   8.25
      FontName        =   "MS Sans Serif"
      ListIndex       =   -1
      Text            =   ""
   End
   Begin ClassSystem.InputNumber txtQty 
      Height          =   315
      Left            =   5760
      TabIndex        =   4
      Top             =   3000
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   556
      BorderStyle     =   1
   End
   Begin ClassSystem.InputNumber txtPrice 
      Height          =   315
      Left            =   3840
      TabIndex        =   5
      Top             =   3000
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   556
      BorderStyle     =   1
   End
   Begin OWC10.PivotTable PivotTable1 
      Height          =   2895
      Left            =   120
      OleObjectBlob   =   "frmPurchaseOrderInsert.frx":0000
      TabIndex        =   6
      Top             =   3480
      Width           =   9690
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "商品"
      Height          =   195
      Left            =   120
      TabIndex        =   31
      Top             =   3120
      Width           =   360
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      Caption         =   "单价"
      Height          =   195
      Left            =   3360
      TabIndex        =   30
      Top             =   3120
      Width           =   360
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      Caption         =   "数量"
      Height          =   195
      Left            =   5280
      TabIndex        =   29
      Top             =   3120
      Width           =   360
   End
End
Attribute VB_Name = "frmPurchaseOrderInsert"
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 frmPurchaseOrder.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 frmPurchaseOrder.sCustID > "" Then
        cbCustomer.SelectItem "ID", frmPurchaseOrder.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