代码之家 › 专栏 › 技术社区 › Brian

运行时的对象属性

class vba excel

Brian · 技术社区 · 6 年前

我想动态地写入自定义类属性。在我的用例中,我有一个带有列标题的表。头是的属性 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 要设置适当属性的列。最多可以有1000行数据。所以我需要为符合条件的行设置属性。

例子

我可能有72行符合条件。因此,我需要将72个类型的对象添加到我的集合中 争议问题 根据最终用户选择的列设置正确的属性。

谢谢!

1 回复 | 直到 6 年前

Rik Sportel 6 年前

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

对于第一期,我创建了一个工作表(“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 到 真

这将允许我们循环选定的项并在 争议问题 相应地分类。

接下来,我添加了对 MicroSoft Scripting Runtime 所以 Dictionary 类可用。这是需要的,因为 Collection 类没有简单的方法可以通过“key”(或属性名,如下所示)检索“property”。

我创造了 争议问题 分类如下:

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

从而得出 收藏 属于 争议问题 对象,其中只填充了所需的属性。您可以使用 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

希望这或多或少是你想要的。

注意:关于为什么选择 词典 而不是 收藏 在里面 this question