Question

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

为清楚起见进行了编辑

这是我的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列，我想设置适当的属性。最多可能有1000行数据。因此，我需要为符合条件的行设置属性。

示例

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

谢谢！

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参数也是一个变量-允许您传递字符串以及实际的Key对象。

要以另一种方式填充另一张工作表，您可以执行以下操作（在相同或不同的模块中；请注意，上面的Sub首先需要运行，否则您的Collection的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

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

为什么选择this question中的Dictionary而不是Collection的更多背景

运行时的对象属性

1 个答案: