Excel VBA:将集合添加到类属性

时间:2015-11-25 19:46:11

标签: vba object collections properties object-properties

我正在开展一个小项目,并且我一直在使用其中一个“字母”来解决问题,它说Arguement不是可选的。

我在这里有clsXML

我收到错误的行是CurrentProduct.Prompts = PromptsCollection

Private Function GetProductsCollection() As Collection
Dim AWP As New clsAWP
Dim PurchaseOrderProductCollection As New Collection
Dim ProductsTopRange As Range
Dim ProductsBottomRange As Range
Dim Row As Range
Dim Product As New clsProduct
Dim PurchaseOrderRange As Range

Set ProductsTopRange = Sheets("Purchase Order").Range("ProductTableTop")
Set ProductsBottomRange = Sheets("Purchase Order").Range("ProductTableBottom")

'Add all Top Range Products
For Each Row In ProductsTopRange.Rows
    If Not IsEmpty(Row.Cells(1, 1).Value) Then
        Dim CurrentSKU As New clsSKU
        Set CurrentSKU = Product.GetSKU(Row.Cells(1, 1).Value)
        If Not IsEmpty(CurrentSKU) And CurrentSKU.Category = "Product" Then
            Dim CurrentProduct As New clsProduct
            CurrentProduct.SKU = Row.Cells(1, 1).Value
            CurrentProduct.Width = Row.Cells(1, 2).Value
            CurrentProduct.Height = Row.Cells(1, 3).Value
            CurrentProduct.Depth = Row.Cells(1, 4).Value
            CurrentProduct.Skins = Row.Cells(1, 10).Value
            CurrentProduct.Swing = Row.Cells(1, 13).Value
            CurrentProduct.Qty = Row.Cells(1, 14).Value

            Dim PromptsCollection As New Collection
            'add all prompts to collection
            Dim ToeKickHeight As New clsPrompt
            ToeKickHeight.Name = "Toe_Kick_Height"
            ToeKickHeight.Value = Row.Cells(1, 18).Value
            PromptsCollection.Add ToeKickHeight

            Dim AdjShelfQty As New clsPrompt
            AdjShelfQty.Name = "Adj_Shelf_Qty"
            AdjShelfQty.Value = Row.Cells(1, 19).Value
            PromptsCollection.Add AdjShelfQty

            Dim LSW As New clsPrompt
            LSW.Name = "Left_Stile_Width"
            LSW.Value = Row.Cells(1, 20).Value
            PromptsCollection.Add LSW

            Dim RSW As New clsPrompt
            RSW.Name = "Right_Stile_Width"
            RSW.Value = Row.Cells(1, 21).Value
            PromptsCollection.Add RSW

            Dim TRW As New clsPrompt
            TRW.Name = "Top_Rail_Width"
            TRW.Value = Row.Cells(1, 22).Value
            PromptsCollection.Add TRW

            Dim BRW As New clsPrompt
            BRW.Name = "Bottom_Rail_Width"
            BRW.Value = Row.Cells(1, 23).Value
            PromptsCollection.Add BRW

            Dim ELSFFD As New clsPrompt
            ELSFFD.Name = "Extend_Left_Side_FF_Down"
            ELSFFD.Value = Row.Cells(1, 24).Value
            PromptsCollection.Add ELSFFD

            Dim ELSFFU As New clsPrompt
            ELSFFU.Name = "Extend_Left_Side_FF_Up"
            ELSFFU.Value = Row.Cells(1, 25).Value
            PromptsCollection.Add ELSFFU

            Dim ERSFFD As New clsPrompt
            ERSFFD.Name = "Extend_Right_Side_FF_Down"
            ERSFFD.Value = Row.Cells(1, 26).Value
            PromptsCollection.Add ERSFFD

            Dim ERSFFU As New clsPrompt
            ERSFFU.Name = "Extend_Right_Side_FF_Up"
            ERSFFU.Value = Row.Cells(1, 27).Value
            PromptsCollection.Add ERSFFU

            Dim ETR As New clsPrompt
            ETR.Name = "Extend_Top_Rail"
            ETR.Value = Row.Cells(1, 28).Value
            PromptsCollection.Add ETR

            Dim EBR As New clsPrompt
            EBR.Name = "Extend_Bottom_Rail"
            EBR.Value = Row.Cells(1, 29).Value
            PromptsCollection.Add EBR

MsgBox (PromptsCollection.Count)
            CurrentProduct.Prompts = PromptsCollection
            CurrentProduct.MVProductName = CurrentSKU.MVProductName

            PurchaseOrderProductCollection.Add CurrentProduct
        End If
    Else
        'skip the row
    End If
Next

这里看一下产品类别,为了清楚起见,我删除了所有其他的getter和字母。

 Option Explicit

 Private pSKU As String
 Private pWidth As String
 Private pHeight As String
 Private pDepth As String
 Private pSkins As String
 Private pSwing As String
 Private pQty As String
 Private pToeKickHeight As String
 Private pAdjShelfQty As String
 Private pLeftStileWidth As String
 Private pRightStileWidth As String
 Private pTopRailWidth As String
 Private pBottomRailWidth As String
 Private pExtLSFFD As String
 Private pExtLSFFU As String
 Private pExtRSFFD As String
 Private pExtRSFFU As String
 Private pExtTopRail As String
 Private pExtBottomRail As String
 Private pMVProductName As String
 Private pPrompts As Collection

Public Property Get Prompts() As Collection
Prompts = pPrompts
End Property

Public Property Let Prompts(Val As Collection)
pPrompts = Val
End Property

Public Function GetSKU(ByVal SKU As String) As Object

Dim DataTable As Range
Dim ProductSKURange As Range
Dim Product As New clsSKU
Dim SheetName As String

SheetName = "Purchase Order"
Set DataTable = Range("DataTable")
Set ProductSKURange = DataTable.Find(SKU, LookIn:=xlValues)
If Not ProductSKURange Is Nothing Then
    Product.SKU = Sheets(SheetName).Range("AE" & ProductSKURange.Row).Value
    Product.A = CDbl(Sheets(SheetName).Range("AF" & ProductSKURange.Row).Value)
    Product.B = CDbl(Sheets(SheetName).Range("AG" & ProductSKURange.Row).Value)
    Product.C = CDbl(Sheets(SheetName).Range("AH" & ProductSKURange.Row).Value)
    Product.D = CDbl(Sheets(SheetName).Range("AI" & ProductSKURange.Row).Value)
    Product.E = CDbl(Sheets(SheetName).Range("AJ" & ProductSKURange.Row).Value)
    Product.F = CDbl(Sheets(SheetName).Range("AK" & ProductSKURange.Row).Value)
    Product.G = CDbl(Sheets(SheetName).Range("AL" & ProductSKURange.Row).Value)
    Product.Description = Sheets(SheetName).Range("AM" & ProductSKURange.Row).Value
    Product.MVProductName = Sheets(SheetName).Range("AN" & ProductSKURange.Row).Value
    Product.Width = Sheets(SheetName).Range("AO" & ProductSKURange.Row).Value
    Product.Height = Sheets(SheetName).Range("AP" & ProductSKURange.Row).Value
    Product.Depth = Sheets(SheetName).Range("AQ" & ProductSKURange.Row).Value
    Product.Category = Sheets(SheetName).Range("AR" & ProductSKURange.Row).Value
End If

Set GetSKU = Product
End Function

请让我知道我哪里出错了。提前谢谢。

1 个答案:

答案 0 :(得分:1)

由于Collection是一个对象,您应该使用Set属性而不是Let
 (注意Set分配值):

Public Property Set Prompts(Val As Collection)
     Set pPrompts = Val
End Property