excel - 运行时的对象属性

Question

我想动态写入自定义类属性。在我的用例中，我有一个带有列标题的表格。标头是Issue类的属性。每期有 120 多个专栏。最终用户选择他们想要包含在报告中的列。当直到运行时才知道列时，如何设置对象的属性？我在谷歌上找不到任何有帮助的东西。

为清楚起见已编辑

这是我的CIssue课程的一个片段：

Option Explicit

Private pIncidentNumber As String
Private pIncidentType As String
Private pContent As String
Private pStartDate As Date
Private pEndDate As Date


Public Property Let IncidentNumber(Value As String)
    pIncidentNumber = Value
End Property
Public Property Get IncidentNumber() As String
    IncidentNumber = pIncidentNumber
End Property
Public Property Let IncidentType(Value As String)
    pIncidentType = Value
End Property
Public Property Get IncidentType() As String
    IncidentType = pIncidentType
End Property
Public Property Let Content(Value As String)
    pContent = Value
End Property
Public Property Get Content() As String
    Content = pContent
End Property
Public Property Let StartDate(Value As Date)
    pStartDate = Value
End Property
Public Property Get StartDate() As Date
    StartDate = pStartDate
End Property
Public Property Let EndDate(Value As Date)
    pEndDate = Value
End Property
Public Property Get EndDate() As Date
    EndDate = pEndDate
End Property

它只会帮助组织我的代码。我也会为此建立一个集合类。如果最终用户选择Incident Number和Content列我想设置适当的属性。最多可以有 1,000 行数据。所以我需要为符合条件的行设置属性。

例子

我可能有 72 行符合条件。因此，我需要CIssue根据最终用户选择的列向我的集合中添加具有正确属性集的 72 个类型的对象。

谢谢！

标签： excelvbaclass

Answer 1

CIssue核心问题：仅在根据列表视图选择的对象中创建属性。

对于第一个问题，我创建了一个工作表（“Sheet1”），向其中添加了一个 ActiveX ListView（MicroSoft ListView 控件，版本 6.0），我在常规模块中填充了列标题（或属性名称），如下所示：

Option Explicit
Sub PopulateListView()
Dim i As Integer
i = 1
With Worksheets("Sheet1")
    .TestListView.ListItems.Clear
    Do While Not IsEmpty(.Cells(1, i))
        .TestListView.ListItems.Add i, , .Cells(1, i).Value
        i = i + 1
    Loop
End With
End Sub

我设置了以下属性：

• Checkboxes至True
• MultiSelect至True

这将允许我们遍历选定的项目并相应地在我们的CIssue类中创建属性。

接下来，我添加了对 的引用MicroSoft Scripting Runtime，因此Dictionary该类可用。这是必需的，因为使用Collection类没有简单的方法可以通过“键”（或属性名称，如下所示）检索“属性”。

我创建的CIssue类如下：

Option Explicit
Private p_Properties As Dictionary
Private Sub Class_Initialize()
    Set p_Properties = New Dictionary
End Sub
Public Sub AddProperty(propertyname As String, value As Variant)
    p_Properties.Add propertyname, value
End Sub
Public Function GetProperty(propertyname As Variant) As Variant
    On Error Resume Next
        GetProperty = p_Properties.Item(propertyname)
    On Error GoTo 0
    If IsEmpty(GetProperty) Then
        GetProperty = False
    End If
End Function
Public Property Get Properties() As Dictionary
    Set Properties = p_Properties 'Return the entire collection of properties
End Property

这样，您可以在常规模块中执行以下操作：

Option Explicit
Public Issue As CIssue
Public Issues As Collection
Public lv As ListView
Sub TestCreateIssues()
Dim i As Integer
Dim Item As ListItem

Set lv = Worksheets("Sheet1").TestListView
Set Issues = New Collection

For i = 2 To 10 'Or however many rows you filtered, for example those 72.
    Set Issue = New CIssue
    For Each Item In lv.ListItems 'Loop over ListItems
        If Item.Checked = True Then ' If the property is selected
            Issue.AddProperty Item.Text, Worksheets("Sheet1").Cells(i, Item.Index).value 'Get the property name and value, and add it.
        End If
    Next Item
    Issues.Add Issue
Next i
End Sub

从而以一个对象结束，Collection这些CIssue对象只填充了所需的属性。您可以使用 检索每个属性CIssue.GetProperty( propertyname )。如果该属性不存在，它将返回“False”，否则返回该属性的值。由于它返回Variant，它将满足日期、字符串等的需求。请注意，如果您想遍历过滤的行，您可以相应地修改上面的循环。请注意，propertyname该方法的参数GetProperty也是一个 Variant - 这允许您传入字符串以及实际Key对象。

要使用您以这种方式捕获的任何内容填充另一个工作表，您可以执行以下操作（在相同或不同的模块中；请注意，Sub上面需要先运行，否则您的 CI 问题集合将不存在。

Sub TestWriteIssues()
Dim i As Integer
Dim j As Integer
Dim Item As ListItem
Dim p As Variant
Dim k As Variant

i = 1
j = 0
'To write all the properties from all issues:
For Each Issue In Issues
    i = i + 1
    For Each p In Issue.Properties.Items
        j = j + 1
        Worksheets("Sheet2").Cells(i, j).value = p
    Next p
    j = 0
Next Issue

'And add the column headers:
i = 0
For Each k In Issues.Item(1).Properties.Keys
    i = i + 1
    Worksheets("Sheet2").Cells(1, i).value = k
    'And to access the single property in one of the Issue objects:
    MsgBox Issues.Item(1).GetProperty(k)
Next k
End Sub

希望这或多或少是你所追求的。

关于为什么选择Dictionary而不是这个问题Collection的 更多背景信息