excel - 运行时的对象属性

Question

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

为清楚起见已编辑

这是我的 CIssue 的片段类(class):

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 行符合条件。因此，我需要将 72 个 CIssue 类型的对象添加到我的集合中。根据最终用户选择的列设置正确的属性。

谢谢!

Answer 1

核心问题:
仅在 CIssue 中创建属性根据 ListView 选择的对象。

对于第一个问题，我创建了一个工作表(“Sheet1”)，并在其中添加了一个 ActiveX ListView (MicroSoft ListView Control，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 的参数方法也是一个变体 - 这允许您传入字符串以及实际的 Key对象。

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

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在 this question