excel - 另一个班级的 VBA 提高活动
问题描述
客观的:
管理用户与 Excel 表 (ListObjects) 交互时发生的情况
最后的想法是为不同的表提供自定义事件。例如,当您向 table1 添加一行时,会引发自定义 AddEvent1,当您对 table2 执行相同操作时,会引发 AddEvent2。
将只有一个类来管理事件,而一个类来保存表格及其信息。
所以建议的过程是:
- 将 listobject 添加到一个名为
Table
- 该类将监听父工作表(
Change
和SelectionChange
)上的事件 TableManager
当更改事件被触发时,从处理这些事件的类中触发一个自定义事件(像adding
,updating
或deleting
rows 的事件)
编辑#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, ByVal EvalCell As Range) As Long
If Intersect(EvalCell, 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, TypeName(Me), "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
解决方案
我试图重现,但后来发现依赖于Worksheet.Activate
注册处理程序往往行为不端:有时您需要“摆动”工作表以使其跟上,尤其是在您编辑代码时。可能就是这样:)
请注意,为了能够触发AddedNewRow
, AddedNewColumn
,甚至RemovedRow
or RemovedColumn
,您需要使用混合Worksheet.Change
和Worksheet.SelectionChange
处理程序不断跟踪表的大小。
表类模块:
'@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)
Public Function Create(ByVal Source As ListObject) As Table
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, TypeName(Me), "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 Not (Target.ListObject Is SourceTable) Then Exit Sub
OnChanged Target
Resize
End Sub
请注意,您可以使用Is
运算符来确定是否Target.ListObject
引用与 相同的对象SourceTable
,而不是使用Application.Intersect
范围:
If Not (Target.ListObject Is SourceTable) Then Exit Sub
从那里我们只需要一个类来处理这个Changed
事件——我把它放在Sheet1
代码隐藏中,但是任何类模块都可以(包括一个UserForm
模块):
Sheet1工作表模块:
'@Folder("VBAProject")
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_Changed(ByVal cell As Range)
MsgBox "Changed " & cell.Address
End Sub
Table
引用仍然需要在某个Set
地方 - 在Open
主机工作簿的处理程序中:
ThisWorkbook工作簿模块:
'@Folder("VBAProject")
Option Explicit
Private Sub Workbook_Open()
With Sheet1
Set .TableEvents = Table.Create(.ListObjects(1))
End With
End Sub
下一步是清理由返回的公共接口Table.Create
- 就目前而言,事情非常混乱,Table
接口有点臃肿:
Sheet1.TableEvents
除非我们做某事,否则所有这些成员都可以使用。如果我们只能像这样公开客户端代码真正需要的成员怎么办?
使用Rubberduck,您可以通过右键单击类中的任意位置并从“重构”菜单中选择“提取接口Table
”来提取接口,然后选择要提取的成员 - 这里是SourceTable
getter(我们不会公开 setter! ):
这将创建一个新的私有类(这将在未来的版本中更改) - 如果接口是从公共类中提取的,则PublicNotCreatable
在属性工具窗口 (F4) 中创建它。
重构将添加Implements ITable
到类的顶部Table
(假设您没有重命名接口),并且将添加此成员:
Private Property Get ITable_SourceTable() As ListObject
Err.Raise 5 'TODO implement interface member
End Property
您需要做的就是提供实现:
Private Property Get ITable_SourceTable() As ListObject
Set ITable_SourceTable = this.SourceTable
End Property
现在Table.Create
可以返回ITable
抽象:
Public Function Create(ByVal Source As ListObject) As ITable
推荐阅读
- python - 创建新的数据框,列向上计数到某个值
- c# - 属性 ... 无法映射,因为它属于“字符串 []”类型,不是受支持的原始类型或有效的实体类型
- autodesk-forge - Autodesk forge 设计自动化 Civil 3d
- python - Python Boto3 s3之间的跨账户转账报错
- java - 尝试模拟在方法内创建的对象时 Mockito.spy 出现 NullPointerException
- python - 为什么 makeblastdb 不能处理语法错误
- html - 我正在使用 django 清脆的表单我如何更改此文本以从顶部开始并在行满时到达下一行
- ios - How to properly add a header to my collection view in xamarin.tvos
- javascript - Angular/ASP:NET - 无法从 base64 上传创建的图像
- flutter - 颤动:listTile 抽屉中的下拉菜单