VBA 7.1 通过循环遍历集合设置多个 class 属性
VBA 7.1 Setting multiple class properties by looping through a collection
自学成才 VBA 菜鸟。如果我违反了礼仪或问了一些其他人都已经知道的事情，我很抱歉。此外，如果我正在做的事情看起来很疯狂，那是因为这是我能想到或实际工作的唯一方法。我工作中有一个部门可以将我的临时代码变成像样的东西，但我必须先给他们一个可行的模型。
我有两个原生程序 VBA。一个是终端模拟器，我用它来抓取大型机数据并构建自定义 class 对象，然后打算将其传递给 MS Excel 进行数字运算。在我可以说服 IT 人员我值得获得 Visual Studio 许可证和脚本访问权限之前，我一直坚持使用 VBA。此外，我必须在内存中传递 class 而不是电子表格，以防程序崩溃；不允许丢失文件中的松散、易于恢复的数据。
数据是最多99行的发票，每行可以为一个项目或一项服务开具账单。发票是自定义发票 class，每一行都是包含在行集合中的自定义行 class。我已经构建并运行了所有内容，但我一直在尝试将行对象设置为其发票行属性。具有以下效果的东西：
For x = 1 To intLines
Invoice.Linex = cLines.Item(x)
Next x
希望在Excel我可以这样使用发票：
currTotalChrg = Invoice.Line01.Charge + Invoice.Line02.Charge
我已经查看了 CallByName 函数，但无法使其正常工作，也找不到可向我展示如何正确设置它的在线示例。没有它，我不知道如何制作我所看到的其他人称为包装器的东西来构造和执行这些行。如果必须的话，我可以构建一个 SelectCasenstein 来完成这项工作，但必须有更好的方法。由于我不会 post 代码（专有问题和政府法规），我完全可以接受含糊的答案；如果指向正确的方向，我可以弄清楚螺母和螺栓。
感谢您抽出时间提供帮助！
您似乎想要一个 Invoice 集合 class，其中包含 InvoiceLineItem 个对象并公开一个 TotalAmount 属性。
您不能直接在 VBE 中编辑 module/member 属性，但是如果您希望能够使用一个很好的 For Each 循环迭代发票的行项目，您将拥有想办法。一种方法是导出 class 并在您喜欢的文本编辑器中对其进行编辑以添加属性，保存它，然后将其重新导入到您的 VBA 项目中。 Rubberduck 的下一个版本将允许您使用 "annotations"（魔术评论）来做到这一点，我也将其包括在这里：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Invoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Const MAX_LINE_ITEMS As Long = 99
Private Type TInvoice
InvoiceNumber As String
InvoiceDate As Date
'other members...
LineItems As Collection
End Type
Private this As TInvoice
Private Sub Class_Initialize()
this.LineItems = New Collection
End Sub
'@Description("Adds an InvoiceLineItem to this invoice. Raises an error if maximum capacity is reached.")
Public Sub AddLineItem(ByVal lineItem As InvoiceLineItem)
Attribute AddLineItem.VB_Description = "Adds an InvoiceLineItem to this invoice."
If this.LineItems.Count = MAX_LINE_ITEMS Then
Err.Raise 5, TypeName(Me), "This invoice already contains " & MAX_LINE_ITEMS & " items."
End If
this.LineItems.Add lineItem
End Sub
'@Description("Gets the line item at the specified index.")
'@DefaultMember
Public Property Get Item(ByVal index As Long) As InvoiceLineItem
Attribute Item.VB_Description = "Gets the line item at the specified index."
Attribute Item.VB_UserMemId = 0
Set Item = this.LineItems(index)
End Property
'@Description("Gets an enumerator that iterates through line items.")
'@Enumerator
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through line items."
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = this.LineItems.[_NewEnum]
End Property
'...other members...
您可以在 class 之外实现总和，但 IMO 那将是 feature envy；一张发票希望能够告诉您它的总金额和数量。
所以我会为此公开属性：
'@Description("Gets the total amount for all line items.")
Public Property Get TotalAmount() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Amount
Next
TotalAmount = result
End Property
'@Description("Gets the total quantity for all line items.")
Public Property Get TotalQuantity() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Quantity
Next
TotalQuantity = result
End Property
然后你不妨...
'@Description("Gets the total net amount for all line items (including taxes, discounts and surcharges).")
Public Property Get TotalNetAmount() As Double
TotalNetAmount = TotalAmount - TotalDiscounts + TotalSurcharges + TaxAmount
End Property
根据你的post和你问题的性质，我怀疑你的class有..什么，99个属性，每行一个发票？
I am stuck with VBA until I can convince the IT folks that I am worthy of a Visual Studio license and scripting access.
VBA 与可以与 Visual Studio 一起使用的任何其他 "real" 语言一样，都是面向对象的语言。上面的解决方案与我在 C# 或 VB.NET 中的实现方式非常相似。如果您的 VBA class 每个可能的发票行都有一个成员，那么您的 想法 是错误的 - 而不是您使用的语言。
不要因为错误的原因而讨厌 VBA。小编很烂，顶一下
我为您提供了部分答案：不完全是您所要求的，但它向您展示了可以做到这一点的语法。
我有一个 'totals' class - 一个简单的字典包装器 - 允许您指定命名字段并开始添加值。这是微不足道的，这样做并没有太多收获......但是请耐心等待：
<pre>
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals<BR />
For Each Field In LoanFileReader.Fields
LoanTotals.CreateField Field.Name
Next Field<BR />
For Each LineItem In LoanFileReader
LoanTotals.Add "LoanAmount", LineItem!LoanAmount
LoanTotals.Add "OutstandingBalance", LineItem!OutstandingBalance
LoanTotals.Add "Collateral", LineItem!Collateral
Next LineItem<BR />
</pre>
class 中的实现细节不是很有趣——你可以算出它都以 Debug.Print LoanTotals.Total("LoanAmount")
结尾
...但是如果我实现这个呢？
<pre>
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals<BR />
For Each Field In LoanFileReader.Fields
LoanTotals.CreateCommand Field.Name, Field.MainframeCommand
Next Field<BR />
</pre>
...内部实现如下：
<pre>
Public Sub ExecuteCommand(CommandName, ParamArray() Args())
' Wrapper for objMainService, ends a command to the COM interface of the Mainframe client<BR />
CallByName objMainService, CommandName, vbMethod, Args<BR />
End Sub
</pre>
或者，您可以连接 Shell 命令来执行这些大型机功能。
...现在您已经填充了一个 VB class，它为运行时提供的一组函数封装了原语 API。
正如我所说：这不是完全你想要的，但它可能会让你更接近你需要的解决方案。
为了完整性，这里是 'Totals' class 的代码：
A VBA Class 用于在运行时指定的命名字段上聚合总计：
<pre>
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsTotals"
Attribute VB_Description = "Simple 'Totals' class based on a Scripting.Dictionary object"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit<BR />
' Simple 'Totals' class based on a Scripting.Dictionary object<BR />
' Nigel Heffernan, Excellerando.Blogspot.com April 2009<BR />
' As it's based on a dictionary, the 'Add' and 'Reset' methods
' support implicit key creation: if you use a new name (or you
' mistype an existing name) a new Totals field will be created<BR /><BR />
' Coding Notes:<BR />
' This is a wrapper class: 'Implements' is not appropriate, as
' we are not reimplementing the class. Or not very much. Think
' of it as the 'syntactic sugar' alternative to prefixing all
' our method calls in the extended class with 'Dictionary_'.<BR />
Private m_dict As Scripting.Dictionary
Attribute m_dict.VB_MemberFlags = 40
Attribute m_dict.VB_VarDescription = "(Internal variable)"<BR />
Public Property Get Sum(FieldName As String) As Double
Attribute Sum.VB_Description = "Returns the current sum of the specified field."
Attribute Sum.VB_UserMemId = 0
' Returns the current sum of the specified field<BR />
Sum = m_dict(FieldName)<BR />
End Property<BR /><BR />
Public Sub CreateField(FieldName As String)
Attribute CreateField.VB_Description = "Explicitly create a new named field"
' Explicitly create a new named field<BR />
If m_dict.Exists(FieldName) Then
Err.Raise 1004, "Totals.CreateField", "There is already a field named '" & FieldName & "' in this 'Totals' object."
Else
m_dict.Add FieldName, 0#
End If<BR />
End Sub<BR /><BR />
Public Sub Add(FieldName As String, Value As Double)
Attribute Add.VB_Description = "Add a numeric amount to the field's running total \r\n Watch out for implicit field creation."
' Add a numeric amount to the field's running total
' Watch out for implicit field creation.<BR />
m_dict(FieldName) = m_dict(FieldName) + Value<BR />
End Sub<BR /><BR />
Public Sub Reset(FieldName As String)
Attribute FieldName.VB_Description = "Reset a named field's total to zero \r\n Watch out for implicit key creation"
' Reset a named field's total to zero
' Watch out for implicit key creation<BR />
m_dict(FieldName) = 0#<BR />
End Sub<BR /><BR />
Public Sub ResetAll()
Attribute ResetAll.VB_Description = "Clear all the totals"
' Clear all the totals<BR />
m_dict.RemoveAll
Set m_dict = Nothing<BR />
End Sub<BR /><BR />
Public Property Get Fields() As Variant
Attribute Fields.VB_Description = "Return a zero-based vector array of the field names"
'Return a zero-based vector array of the field names<BR />
Fields = m_dict.Keys<BR />
End Property<BR />
Public Property Get Values() As Variant
Attribute Values.VB_Description = "Return a zero-based vector array of the current totals"
'Return a zero-based vector array of the current totals<BR />
Fields = m_dict.Items<BR />
End Property<BR /><BR />
Public Property Get Count() As Long
Attribute Count.VB_Description = "Return the number of fields"
'Return the number of fields<BR />
Count= m_dict.Count<BR />
End Property<BR />
Public Property Get Exists(FieldName As String) As Boolean
Attribute Count.VB_Description = "Return a zero-based vector array of the field names"
'Return True if a named field exists in this instance of clsTotals<BR />
Exists = m_dict.Exists(FieldName)<BR />
End Property<BR /><BR />
Private Sub Class_Initialize()<BR />
Set m_dict = New Scripting.Dictionary
m_dict.CompareMode = TextCompare<BR /><br>
End Sub<BR /><BR />
Private Sub Class_Terminate()<BR />
m_dict.RemoveAll
Set m_dict = Nothing<BR />
End Sub<BR />
如果您无法将属性语句导入到您的项目中，请注释掉它们。
自学成才 VBA 菜鸟。如果我违反了礼仪或问了一些其他人都已经知道的事情，我很抱歉。此外，如果我正在做的事情看起来很疯狂，那是因为这是我能想到或实际工作的唯一方法。我工作中有一个部门可以将我的临时代码变成像样的东西，但我必须先给他们一个可行的模型。
我有两个原生程序 VBA。一个是终端模拟器，我用它来抓取大型机数据并构建自定义 class 对象，然后打算将其传递给 MS Excel 进行数字运算。在我可以说服 IT 人员我值得获得 Visual Studio 许可证和脚本访问权限之前，我一直坚持使用 VBA。此外，我必须在内存中传递 class 而不是电子表格，以防程序崩溃；不允许丢失文件中的松散、易于恢复的数据。
数据是最多99行的发票，每行可以为一个项目或一项服务开具账单。发票是自定义发票 class，每一行都是包含在行集合中的自定义行 class。我已经构建并运行了所有内容，但我一直在尝试将行对象设置为其发票行属性。具有以下效果的东西：
For x = 1 To intLines
Invoice.Linex = cLines.Item(x)
Next x
希望在Excel我可以这样使用发票：
currTotalChrg = Invoice.Line01.Charge + Invoice.Line02.Charge
我已经查看了 CallByName 函数，但无法使其正常工作，也找不到可向我展示如何正确设置它的在线示例。没有它，我不知道如何制作我所看到的其他人称为包装器的东西来构造和执行这些行。如果必须的话，我可以构建一个 SelectCasenstein 来完成这项工作，但必须有更好的方法。由于我不会 post 代码（专有问题和政府法规），我完全可以接受含糊的答案；如果指向正确的方向，我可以弄清楚螺母和螺栓。
感谢您抽出时间提供帮助！
您似乎想要一个 Invoice 集合 class，其中包含 InvoiceLineItem 个对象并公开一个 TotalAmount 属性。
您不能直接在 VBE 中编辑 module/member 属性，但是如果您希望能够使用一个很好的 For Each 循环迭代发票的行项目，您将拥有想办法。一种方法是导出 class 并在您喜欢的文本编辑器中对其进行编辑以添加属性，保存它，然后将其重新导入到您的 VBA 项目中。 Rubberduck 的下一个版本将允许您使用 "annotations"（魔术评论）来做到这一点，我也将其包括在这里：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Invoice"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Const MAX_LINE_ITEMS As Long = 99
Private Type TInvoice
InvoiceNumber As String
InvoiceDate As Date
'other members...
LineItems As Collection
End Type
Private this As TInvoice
Private Sub Class_Initialize()
this.LineItems = New Collection
End Sub
'@Description("Adds an InvoiceLineItem to this invoice. Raises an error if maximum capacity is reached.")
Public Sub AddLineItem(ByVal lineItem As InvoiceLineItem)
Attribute AddLineItem.VB_Description = "Adds an InvoiceLineItem to this invoice."
If this.LineItems.Count = MAX_LINE_ITEMS Then
Err.Raise 5, TypeName(Me), "This invoice already contains " & MAX_LINE_ITEMS & " items."
End If
this.LineItems.Add lineItem
End Sub
'@Description("Gets the line item at the specified index.")
'@DefaultMember
Public Property Get Item(ByVal index As Long) As InvoiceLineItem
Attribute Item.VB_Description = "Gets the line item at the specified index."
Attribute Item.VB_UserMemId = 0
Set Item = this.LineItems(index)
End Property
'@Description("Gets an enumerator that iterates through line items.")
'@Enumerator
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through line items."
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = this.LineItems.[_NewEnum]
End Property
'...other members...
您可以在 class 之外实现总和，但 IMO 那将是 feature envy；一张发票希望能够告诉您它的总金额和数量。
所以我会为此公开属性：
'@Description("Gets the total amount for all line items.")
Public Property Get TotalAmount() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Amount
Next
TotalAmount = result
End Property
'@Description("Gets the total quantity for all line items.")
Public Property Get TotalQuantity() As Double
Dim result As Double
Dim lineItem As InvoiceLineItem
For Each lineItem In this.LineItems
result = result + lineItem.Quantity
Next
TotalQuantity = result
End Property
然后你不妨...
'@Description("Gets the total net amount for all line items (including taxes, discounts and surcharges).")
Public Property Get TotalNetAmount() As Double
TotalNetAmount = TotalAmount - TotalDiscounts + TotalSurcharges + TaxAmount
End Property
根据你的post和你问题的性质，我怀疑你的class有..什么，99个属性，每行一个发票？
I am stuck with VBA until I can convince the IT folks that I am worthy of a Visual Studio license and scripting access.
VBA 与可以与 Visual Studio 一起使用的任何其他 "real" 语言一样，都是面向对象的语言。上面的解决方案与我在 C# 或 VB.NET 中的实现方式非常相似。如果您的 VBA class 每个可能的发票行都有一个成员，那么您的 想法 是错误的 - 而不是您使用的语言。
不要因为错误的原因而讨厌 VBA。小编很烂，顶一下
我为您提供了部分答案：不完全是您所要求的，但它向您展示了可以做到这一点的语法。
我有一个 'totals' class - 一个简单的字典包装器 - 允许您指定命名字段并开始添加值。这是微不足道的，这样做并没有太多收获......但是请耐心等待：
<pre>
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals<BR />
For Each Field In LoanFileReader.Fields
LoanTotals.CreateField Field.Name
Next Field<BR />
For Each LineItem In LoanFileReader
LoanTotals.Add "LoanAmount", LineItem!LoanAmount
LoanTotals.Add "OutstandingBalance", LineItem!OutstandingBalance
LoanTotals.Add "Collateral", LineItem!Collateral
Next LineItem<BR />
</pre>
class 中的实现细节不是很有趣——你可以算出它都以 Debug.Print LoanTotals.Total("LoanAmount")
...但是如果我实现这个呢？
<pre>
Dim LoanTotals As clsTotals
Set LoanTotals = New clsTotals<BR />
For Each Field In LoanFileReader.Fields
LoanTotals.CreateCommand Field.Name, Field.MainframeCommand
Next Field<BR />
</pre>
...内部实现如下：
<pre>
Public Sub ExecuteCommand(CommandName, ParamArray() Args())
' Wrapper for objMainService, ends a command to the COM interface of the Mainframe client<BR />
CallByName objMainService, CommandName, vbMethod, Args<BR />
End Sub
</pre>
或者，您可以连接 Shell 命令来执行这些大型机功能。
...现在您已经填充了一个 VB class，它为运行时提供的一组函数封装了原语 API。
正如我所说：这不是完全你想要的，但它可能会让你更接近你需要的解决方案。
为了完整性，这里是 'Totals' class 的代码：
A VBA Class 用于在运行时指定的命名字段上聚合总计：
<pre>
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsTotals"
Attribute VB_Description = "Simple 'Totals' class based on a Scripting.Dictionary object"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit<BR />
' Simple 'Totals' class based on a Scripting.Dictionary object<BR />
' Nigel Heffernan, Excellerando.Blogspot.com April 2009<BR />
' As it's based on a dictionary, the 'Add' and 'Reset' methods
' support implicit key creation: if you use a new name (or you
' mistype an existing name) a new Totals field will be created<BR /><BR />
' Coding Notes:<BR />
' This is a wrapper class: 'Implements' is not appropriate, as
' we are not reimplementing the class. Or not very much. Think
' of it as the 'syntactic sugar' alternative to prefixing all
' our method calls in the extended class with 'Dictionary_'.<BR />
Private m_dict As Scripting.Dictionary
Attribute m_dict.VB_MemberFlags = 40
Attribute m_dict.VB_VarDescription = "(Internal variable)"<BR />
Public Property Get Sum(FieldName As String) As Double
Attribute Sum.VB_Description = "Returns the current sum of the specified field."
Attribute Sum.VB_UserMemId = 0
' Returns the current sum of the specified field<BR />
Sum = m_dict(FieldName)<BR />
End Property<BR /><BR />
Public Sub CreateField(FieldName As String)
Attribute CreateField.VB_Description = "Explicitly create a new named field"
' Explicitly create a new named field<BR />
If m_dict.Exists(FieldName) Then
Err.Raise 1004, "Totals.CreateField", "There is already a field named '" & FieldName & "' in this 'Totals' object."
Else
m_dict.Add FieldName, 0#
End If<BR />
End Sub<BR /><BR />
Public Sub Add(FieldName As String, Value As Double)
Attribute Add.VB_Description = "Add a numeric amount to the field's running total \r\n Watch out for implicit field creation."
' Add a numeric amount to the field's running total
' Watch out for implicit field creation.<BR />
m_dict(FieldName) = m_dict(FieldName) + Value<BR />
End Sub<BR /><BR />
Public Sub Reset(FieldName As String)
Attribute FieldName.VB_Description = "Reset a named field's total to zero \r\n Watch out for implicit key creation"
' Reset a named field's total to zero
' Watch out for implicit key creation<BR />
m_dict(FieldName) = 0#<BR />
End Sub<BR /><BR />
Public Sub ResetAll()
Attribute ResetAll.VB_Description = "Clear all the totals"
' Clear all the totals<BR />
m_dict.RemoveAll
Set m_dict = Nothing<BR />
End Sub<BR /><BR />
Public Property Get Fields() As Variant
Attribute Fields.VB_Description = "Return a zero-based vector array of the field names"
'Return a zero-based vector array of the field names<BR />
Fields = m_dict.Keys<BR />
End Property<BR />
Public Property Get Values() As Variant
Attribute Values.VB_Description = "Return a zero-based vector array of the current totals"
'Return a zero-based vector array of the current totals<BR />
Fields = m_dict.Items<BR />
End Property<BR /><BR />
Public Property Get Count() As Long
Attribute Count.VB_Description = "Return the number of fields"
'Return the number of fields<BR />
Count= m_dict.Count<BR />
End Property<BR />
Public Property Get Exists(FieldName As String) As Boolean
Attribute Count.VB_Description = "Return a zero-based vector array of the field names"
'Return True if a named field exists in this instance of clsTotals<BR />
Exists = m_dict.Exists(FieldName)<BR />
End Property<BR /><BR />
Private Sub Class_Initialize()<BR />
Set m_dict = New Scripting.Dictionary
m_dict.CompareMode = TextCompare<BR /><br>
End Sub<BR /><BR />
Private Sub Class_Terminate()<BR />
m_dict.RemoveAll
Set m_dict = Nothing<BR />
End Sub<BR />
如果您无法将属性语句导入到您的项目中，请注释掉它们。