将对象属性绑定到工作表单元格的技术

时间:2019-07-15 18:18:50

标签: excel vba

编辑: 我要在这里完成的三件事是:

  • 能够将属性/方法封装到一个类中(足够容易)
  • 使用excel范围作为用户输入,以供用户操纵类属性值。
  • (奖励)将用户更改发送回数据库。

我一直在想在vba中构建一些东西的想法,这使我可以将对象的属性绑定到Range。基本上将一个单元格变成一个绑定控件。

我可能要遵循的一些基本要求包括:

  • 更改对象属性将更新单元格值
  • 更改单元格将更新对象属性
  • 对象属性可以绑定/解除绑定而不会丢失该属性的值。

我最初的想法是建立一个BindRange类,该类仅从某个范围获取其值并将其值设置为该范围。

BindRange.cls:

Option Explicit

Private p_BoundCell As Range

Public Property Get Value() As String
    If Me.IsBound Then Value = p_BoundCell.Value
End Property

Public Property Let Value(Val As String)
    If Me.IsBound Then p_BoundCell.Value = Val
End Property

Public Property Get IsBound() As Boolean
    If BoundToDeletedCell Then
        Set p_BoundCell = Nothing
    End If

    IsBound = Not (p_BoundCell Is Nothing)

End Property

Public Sub Bind(Cell As Range)
    Set p_BoundCell = Cell(1, 1)
End Sub


Private Function BoundToDeletedCell() As Boolean
    Dim sTestAddress As String

    On Error Resume Next
TRY:
    If p_BoundCell Is Nothing Then
        Exit Function
        '// returns false
    End If

    sTestAddress = p_BoundCell.Address

    If Err.Number = 424 Then 'object required
        BoundToDeletedCell = True
    End If

End Function

然后,我可以使用一对字段设置我的自定义对象来管理更新。我还需要一种方法来公开设置要绑定的范围。

TestObject.cls:

Option Explicit

Private p_BindId As BindRange
Private p_Id As String

Public Property Get Id() As String

    If p_BindId.IsBound Then
        p_Id = p_BindId.Value
    End If

    Id = p_Id

End Property
Public Property Let Id(Val As String)

    p_Id = Val

    If p_BindId.IsBound Then
        p_BindId.Value = p_Id
    End If

End Property

Public Sub Id_Bind(Cell As Range)
    p_BindId.Bind Cell
End Sub

Private Sub Class_Initialize()
    Set p_BindId = New BindRange
End Sub

Private Sub Class_Terminate()
    Set p_BindId = Nothing
End Sub

这可能很烦人,因为我要使其成为“可绑定”的任何属性,我都必须管理每个属性的“获取/设置”和“绑定”。我也不太确定这是否会引起任何内存问题:使用具有变量类型值的类属性。...

还考虑建立类似服务的类,以类字典结构跟踪对象及其绑定范围吗?

无论如何,只是想知道是否有人以前做过这样的事情,或者您是否对如何设计它有任何想法。

1 个答案:

答案 0 :(得分:4)

将单个细胞绑定到属性将非常麻烦。我认为更好的技术是创建一个表以充当属性表和一个引发PropertySheetWatcher事件的PropertyChange

例如,假设我们要在一个调用Stack OverKill的用户表单上创建一个简单的游戏。我们的游戏将有其英雄类别和多个敌人类别(例如Turtle,Rhino,Wolf)。尽管每个类都有其自己的业务逻辑,但它们都共享公共属性(名称,HP,ClassName,Left,Right等)。自然,由于它们都确保相同的基本属性集,因此它们都应实现一个公共接口(例如CharacterInterface)。这样做的好处是它们可以共享相同的属性表。

模拟属性表表

Property Sheet Table Image

PropertySheetWatcher:Class

Private WithEvents ws As Worksheet
Public Table As ListObject
Public Event PropertyChange(ByVal PropertyName As String, Value As Variant)

Public Sub Init(ByRef PropertySheetTable As ListObject)
    Set ws = PropertySheetTable.Parent
    Set Table = PropertySheetTable
End Sub

Private Sub ws_Change(ByVal Target As Range)
    Dim PropertyName As String
    If Not Intersect(Target, Table.DataBodyRange) Then
        PropertyName = Intersect(Target.EntireColumn, Table.HeaderRowRange).Value
        RaiseEvent PropertyChange(PropertyName, Target.Value)
    End If
End Sub

Public Sub UpdateProperty(ByVal PropertyName As String, Name As String, Value As Variant)
    Application.EnableEvents = False
    Dim RowIndex As Long
    RowIndex = Table.ListColumns("Name").DataBodyRange.Find(Name).Row
    Table.ListColumns(PropertyName).DataBodyRange.Cells(RowIndex).Value = Value
    Application.EnableEvents = True
End Sub

Hero:Class

Implements CharacterInterface
Private Type Members
    Name As String
    HP As Single
    ClassName As String
    Left As Single
    Right As Single
    Top As Single
    Bottom As Single
    Direction  As Long
    Speed  As Single
End Type
Private m As Members

Public WithEvents Watcher As PropertySheetWatcher

Private Sub Watcher_PropertyChange(ByVal PropertyName As String, Value As Variant)
    Select Case PropertyName
    Case "Speed"
        Speed = Value
    Case "HP"
    '....More Code
    End Select

End Sub

Public Property Get Speed() As Single
    Speed = m.Speed
End Property

Public Property Let Speed(ByVal Value As Single)
    m.Speed = Speed
    Watcher.UpdateProperty "Speed", m.Name, Value
End Property

Private Property Get CharacterInterface_Speed() As Single
    CharacterInterface_Speed = Speed
End Property

Private Property Let CharacterInterface_Speed(ByVal Value As Single)
    Speed = Value
End Property

以上给出的类是如何实现通知系统的快速模型。但是,等等还有更多!

看看设置一个Factory来基于保存的设置重现所有out字符有多么容易。

CharacterFactory:Class

Function AddCharacters(Watcher As PropertySheetWatcher) As CharacterInterface
    Dim Table As ListObject
    Dim data As Variant
    Dim RowIndex As Long

    With Table
        data = .DataBodyRange.Value

        For RowIndex = 1 To UBound(data)
            Select Case data(RowIndex, .ListColumns("Class").Index)
            Case "Hero"
                Set AddCharacters = AddCharacter(New Hero, Table, RowIndex)
            Case "Turtle"
                Set AddCharacters = AddCharacter(New Turtle, Table, RowIndex)
            Case "Rhino"
                Set AddCharacters = AddCharacter(New Rhino, Table, RowIndex)
            Case "Wolf"
                Set AddCharacters = AddCharacter(New Wolf, Table, RowIndex)
            End Select
        Next
    End With
End Function

Private Function AddCharacter(Character As CharacterInterface, Table As ListObject, RowIndex As Long) As Object
    With Character
        .Speed = Table.ListColumns("Speed").DataBodyRange.Cells(RowIndex).Value
        '....More Coe
    End With
    Set AddCharacter = Character
End Function

似乎我写了很多原始内容,但没有。整个设置是对来自不同流行设计模式的概念的适应。