私は小さなプロジェクトに取り組んでいますが、引数がオプションではないと言っている「文字」の1つに問題が発生し続けています。
私はここにある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
ここでは、product クラスの内部を見ていきます。わかりやすくするために、他のすべてのゲッターと文字を削除しました。
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
どこが間違っているのか教えてください。前もって感謝します。