编辑: 我要在这里完成的三件事是:
我一直在想在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
这可能很烦人,因为我要使其成为“可绑定”的任何属性,我都必须管理每个属性的“获取/设置”和“绑定”。我也不太确定这是否会引起任何内存问题:使用具有变量类型值的类属性。...
还考虑建立类似服务的类,以类字典结构跟踪对象及其绑定范围吗?
无论如何,只是想知道是否有人以前做过这样的事情,或者您是否对如何设计它有任何想法。
答案 0 :(得分:4)
将单个细胞绑定到属性将非常麻烦。我认为更好的技术是创建一个表以充当属性表和一个引发PropertySheetWatcher
事件的PropertyChange
。
例如,假设我们要在一个调用Stack OverKill的用户表单上创建一个简单的游戏。我们的游戏将有其英雄类别和多个敌人类别(例如Turtle,Rhino,Wolf)。尽管每个类都有其自己的业务逻辑,但它们都共享公共属性(名称,HP,ClassName,Left,Right等)。自然,由于它们都确保相同的基本属性集,因此它们都应实现一个公共接口(例如CharacterInterface
)。这样做的好处是它们可以共享相同的属性表。
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
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字符有多么容易。
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
似乎我写了很多原始内容,但没有。整个设置是对来自不同流行设计模式的概念的适应。