VBA 7.1通过循环集合设置多个类属性

这里是自学成才的VBA noob。如果我违反了ettiquette或是问了其他人都知道的事情，我很抱歉。而且，如果我做的事情看起来很疯狂，那是因为这是我唯一能想到或真正发挥作用的方法。在我的工作中有一个部门可以把我的临时代码转换成一些像样的东西，但我必须首先给他们一个可行的模型

我有两个使用本机VBA的程序。一个是终端仿真器，我正在使用它来刮取大型机数据并构造一个自定义类对象，然后打算将其传递给MS Excel进行数字处理。我一直坚持使用VBA，直到我能够说服IT人员我值得拥有Visual Studio许可证和脚本访问权限。此外，我必须在内存中传递该类，而不是在程序崩溃的情况下传递电子表格；丢失的文件中不允许有松散的、易于恢复的数据

数据是一张最多有99行的发票，每行可以为一个项目或一项服务开具账单。发票是一个自定义发票类，每一行都是一个包含在行集合中的自定义行类。我已经构建并运行了所有内容，但我一直在尝试将行对象设置为其发票行属性。具有这种效果的东西：

For x = 1 To intLines
    Invoice.Linex = cLines.Item(x)
Next x

希望在Excel中我可以像这样使用发票：

currTotalChrg = Invoice.Line01.Charge + Invoice.Line02.Charge

我查看了CallByName函数，但无法使其正常工作，也找不到在线示例来演示如何正确设置它。如果没有这些，我就不知道如何让我看到的其他人称之为包装器来构造和执行这些行。如果我必须的话，我可以构建一个SelectCasenstein来完成这项工作，但肯定有更好的方法。由于我不能发布代码专有问题和政府法规，我对含糊不清的回答完全没有问题；如果指向正确的方向，我可以找出螺母和螺栓

谢谢你的时间和帮助

似乎需要一个Invoice集合类，该类保存InvoiceLineItem对象并公开TotalAmount属性

您不能直接在VBE中编辑模块/成员属性，但是如果您希望能够使用“每个循环都有一个尼斯”循环来迭代发票的行项目，您必须找到一种方法。一种方法是导出类并在您喜爱的文本编辑器中编辑它，以添加属性，保存它，然后将其重新导入到VBA项目中。的下一个版本将允许您使用注释和魔术注释来实现这一点，我在这里还包括：

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...

您可以在类之外实现sum，但在我看来，这将是功能嫉妒；发票希望能够告诉您其总金额和数量

因此，我将公开其属性：

'@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

从你的帖子和问题的性质来看，我怀疑你的班级。。什么，99个属性，发票上每行一个

我一直坚持使用VBA，直到我能够说服IT人员我值得拥有Visual Studio许可证和脚本访问权限

VBA是一种面向对象的语言，与VisualStudio中使用的任何其他实际语言一样。上述解决方案与我在C或VB.NET中实现它的方式非常相似。如果VBA类的每个可能的发票行都有一个成员，那么您的想法是错误的，而不是您使用的语言

---

不要因为错误的理由而憎恨VBA。编辑太差劲了，算了吧。

我有一个部分答案给你：不完全是你要求的，但它向你展示了一种可以做到这一点的语法

我有一个“totals”类——一个字典的简单包装器——允许您指定命名字段并开始添加值。这是琐碎的，而且这样做没有什么好处。。。但请容忍我：

…内部实现如下：

currTotalChrg = Invoice.Line01.Charge + Invoice.Line02.Charge

---

如果无法将属性语句导入到项目中，请将其注释掉。

如果您已经有一个行对象集合，为什么不将其作为发票对象中的行属性？VBA不支持您在示例代码中显示的类型：使用数组或现有集合更好地支持该类型的作业。此外，如果您的集合包含对象，则需要使用Set将其中一个对象分配到其他位置。Invoice.Linex只是一种糟糕的设计。如果一张发票突然可以有1000000行，您是否要使您的发票类有1000000个属性？提示：当模块超过10K行时，VBA停止编译-您需要更好的方法。 Dim LoanTotals As clsTotals Set LoanTotals = New clsTotals
For Each Field In LoanFileReader.Fields LoanTotals.CreateCommand Field.Name, Field.MainframeCommand Next Field
Public Sub ExecuteCommand(CommandName, ParamArray() Args()) ' Wrapper for objMainService, ends a command to the COM interface of the Mainframe client
CallByName objMainService, CommandName, vbMethod, Args
End Sub 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
' Simple 'Totals' class based on a Scripting.Dictionary object
' Nigel Heffernan, Excellerando.Blogspot.com April 2009
' 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

' Coding Notes:
' 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_'.
Private m_dict As Scripting.Dictionary Attribute m_dict.VB_MemberFlags = 40 Attribute m_dict.VB_VarDescription = "(Internal variable)"
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
Sum = m_dict(FieldName)
End Property

Public Sub CreateField(FieldName As String) Attribute CreateField.VB_Description = "Explicitly create a new named field" ' Explicitly create a new named field
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
End Sub

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.
m_dict(FieldName) = m_dict(FieldName) + Value
End Sub

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
m_dict(FieldName) = 0#
End Sub

Public Sub ResetAll() Attribute ResetAll.VB_Description = "Clear all the totals" ' Clear all the totals
m_dict.RemoveAll Set m_dict = Nothing
End Sub

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
Fields = m_dict.Keys
End Property
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
Fields = m_dict.Items
End Property

Public Property Get Count() As Long Attribute Count.VB_Description = "Return the number of fields" 'Return the number of fields
Count= m_dict.Count
End Property
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
Exists = m_dict.Exists(FieldName)
End Property

Private Sub Class_Initialize()
Set m_dict = New Scripting.Dictionary m_dict.CompareMode = TextCompare

End Sub

Private Sub Class_Terminate()
m_dict.RemoveAll Set m_dict = Nothing
End Sub