我正在尝试实施this post in codereview的建议
目标:
管理当用户与Excel表(ListObjects)交互时会发生什么
最后的想法是为不同的表提供定制事件。例如在table1中添加一行时,将引发自定义AddEvent1,而在table2中进行此操作时,将引发AddEvent2。
只有一个类可以管理事件,而一个类可以保存表及其信息。
因此建议的过程是:
- 将列表对象添加到名为
Table
的类中 - 该类将侦听父表(
Change
和SelectionChange
)上的事件 - 当触发更改事件时,从处理这些事件的类
TableManager
触发一个自定义事件(诸如adding
,updating
或deleting
行之类的事件)
编辑#1:
调整代码:
-
Create
函数现在返回Table
的实例 - 属性
Set Sourcetable
现在将listObjectParentSheet
字段设置为相应的值
但是Table Manager
仍然没有收听listObjectParentSheet_Change
引发的事件
组件:
1)带有Excel表(ListObject)的工作表,其后包含以下代码:
Private Sub Worksheet_activate()
Dim myTable As Table
Dim myTableManager As TableManager
Set myTable = Table.Create(Me.ListObjects(1))
Set myTableManager = New TableManager
Set myTableManager.TableInstance = myTable
End Sub
2)类Table
(使用rubberduck的ID设置为true)
'@Folder("VBAProject")
Option Explicit
'@PredeclaredId
Private Type TTable
Sourcetable As ListObject
End Type
Private this As TTable
Private WithEvents listObjectParentSheet As Excel.Worksheet
Public Event AddEvent()
Public Property Get Sourcetable() As ListObject
Set Sourcetable = this.Sourcetable
End Property
Public Property Set Sourcetable(ByVal value As ListObject)
Set this.Sourcetable = value
Set listObjectParentSheet = value.Parent
End Property
Public Property Get Self() As Table
Set Self = Me
End Property
Public Function Create(ByVal EvalSourcetable As ListObject) As Table
With New Table
Set .Sourcetable = EvalSourcetable
Set Create = .Self
End With
End Function
Private Sub listObjectParentSheet_Change(ByVal Target As Range)
If Not Intersect(Target,Sourcetable.DataBodyRange) Is Nothing Then
MsgBox listObjectParentSheet.Name & " " & Target.Address
RaiseEvent AddEvent
End If
End Sub
3)类TableManager
Option Explicit
Private WithEvents m_table As Table
Public Property Get TableInstance() As Table
Set TableInstance = m_table
End Property
Public Property Set TableInstance(ByRef tableObject As Table)
Set m_table = tableObject
End Property
Private Sub m_table_AddEvent()
MsgBox "Adding something"
End Sub
问题/问题:
我还没有弄清楚如何在TableManager
类中触发“ AddEvent”。我知道我搞砸了一些实例化类的概念,但是我不知道自己在做什么错。
预期结果:
当用户更改列表对象的任何单元格时,在抬起AddEvent
时显示消息框“添加内容”
任何帮助将不胜感激。
编辑#2
最终代码要感谢Mat的回答:
表格:Sheet1
:
Private Sub Worksheet_activate()
With TableManager
Set .TableEvents = Table.Create(Sheet1.ListObjects(1))
End With
End Sub
模块:ListObjectUtilities
Option Explicit
Public Function getcellRow(ByVal EvalTable As ListObject,ByVal EvalCell As Range) As Long
If Intersect(EvalCell,EvalTable.DataBodyRange) Is Nothing Then Exit Function
getcellRow = EvalCell.Row - EvalTable.HeaderRowRange.Row
End Function
Public Function getcellColumn(ByVal EvalTable As ListObject,EvalTable.DataBodyRange) Is Nothing Then Exit Function
getcellColumn = EvalCell.Column - EvalTable.HeaderRowRange.Column + 1
End Function
班级:ITable
Option Explicit
Public Property Get Sourcetable() As ListObject
End Property
班级:Table
'@Folder("VBAProject")
'@PredeclaredId
Option Explicit
Private WithEvents TableSheet As Excel.Worksheet
Private Type TTable
Sourcetable As ListObject
LastRowCount As Long
LastColumnCount As Long
End Type
Private this As TTable
Public Event Changed(ByVal cell As Range)
Public Event AddedNewRow(ByVal newRow As ListRow)
Public Event AddedNewColumn(ByVal newColumn As ListColumn)
Implements ITable
Public Function Create(ByVal Source As ListObject) As ITable
With New Table
Set .Sourcetable = Source
Set Create = .Self
End With
End Function
Public Property Get Self() As Table
Set Self = Me
End Property
Public Property Get Sourcetable() As ListObject
Set Sourcetable = this.Sourcetable
End Property
Public Property Set Sourcetable(ByVal value As ListObject)
ThrowIfSet this.Sourcetable
ThrowIfNothing value
Set TableSheet = value.Parent
Set this.Sourcetable = value
Resize
End Property
Friend Sub OnChanged(ByVal Target As Range)
RaiseEvent Changed(Target)
End Sub
Friend Sub OnAddedNewRow(ByVal newRow As ListRow)
RaiseEvent AddedNewRow(newRow)
End Sub
Friend Sub OnAddedNewColumn(ByVal newColumn As ListColumn)
RaiseEvent AddedNewColumn(newColumn)
End Sub
Private Sub ThrowIfNothing(ByVal Target As Object)
If Target Is Nothing Then Err.Raise 5,TypeName(Me),"Argument cannot be a null reference."
End Sub
Private Sub ThrowIfSet(ByVal Target As Object)
If Not Target Is Nothing Then Err.Raise 5,"This reference is already set."
End Sub
Private Sub Resize()
With this.Sourcetable
this.LastRowCount = .ListRows.Count
this.LastColumnCount = .ListColumns.Count
End With
End Sub
Private Sub TableSheet_Change(ByVal Target As Range)
If Intersect(Target,Sourcetable.DataBodyRange) Is Nothing Then Exit Sub
Select Case True
Case this.Sourcetable.DataBodyRange.Columns.Count > this.LastColumnCount
OnAddedNewColumn Sourcetable.ListColumns(ListObjectUtilities.getcellColumn(this.Sourcetable,Target))
Case this.Sourcetable.DataBodyRange.Rows.Count > this.LastRowCount
OnAddedNewRow Sourcetable.ListRows(ListObjectUtilities.getcellRow(this.Sourcetable,Target))
Case Else
OnChanged Target
End Select
Resize
End Sub
Private Property Get ITable_Sourcetable() As ListObject
Set ITable_Sourcetable = this.Sourcetable
End Property
班级:TableManager
'@Folder("VBAProject")
'@PredeclaredId
Option Explicit
Private WithEvents MyTable As Table
Public Property Get TableEvents() As Table
Set TableEvents = MyTable
End Property
Public Property Set TableEvents(ByVal value As Table)
Set MyTable = value
End Property
Private Sub MyTable_AddedNewColumn(ByVal newColumn As ListColumn)
MsgBox "Added new column " & newColumn.Range.Column
End Sub
Private Sub MyTable_AddedNewRow(ByVal newRow As ListRow)
MsgBox "Added new row " & newRow.Range.Row
End Sub
Private Sub MyTable_Changed(ByVal cell As Range)
MsgBox "Changed " & cell.Address
End Sub