Я попытался воспроизвести, но потом обнаружил, что, опираясь на Worksheet.Activate, чтобы зарегистрировать обработчик, он ведет себя неправильно: иногда вам нужно «покачивать» лист, чтобы он продолжал работать, особенно если вы редактируете код. Может быть просто так:)
Обратите внимание, что для того, чтобы иметь возможность выстрелить AddedNewRow, AddedNewColumn, или даже RemovedRow или RemovedColumn, вам необходимо постоянно отслеживать размер таблица со смесью обработчиков Worksheet.Change и Worksheet.SelectionChange.
Таблица * Модуль класса 1013 *:
'@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 - I поместите это в коде 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
Следующим шагом будет очистка интерфейса publi c, возвращаемого Table.Create - в его нынешнем состоянии все довольно запутанно, и Table в terface немного раздут:
Все эти участники будут доступны для Sheet1.TableEvents, если мы не сделаем что-нибудь. Что если бы мы могли выставить членам только тот код клиента, который действительно нужен, вот так?
С Rubberduck вы можете Извлеките интерфейс , щелкнув правой кнопкой мыши в любом месте класса Table и выбрав «Извлечь интерфейс» в меню «Рефакторинг», а затем выберите элементы для извлечения - здесь получатель SourceTable (мы не собираюсь выставить сеттер!):
Это создаст новый закрытый класс (это изменится в будущих выпусках) - сделайте его PublicNotCreatable в свойствах toolwindow (F4), если интерфейс был извлечен из класса publi c.
Рефакторинг добавит 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