AW: VBA SheetChange
06.07.2022 15:05:32
Nepumuk
Hallo Joschi,
im Modul "DieseArbeitsmappe":
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case CheckRows(Sh)
Case 0 'no row delete or insert
Case 1 'row insert
MsgBox Application.UserName & " insert row"
Case 2 'row delete
MsgBox Application.UserName & " delete row"
End Select
Select Case CheckColumns(Sh)
Case 0 'no column delete or insert
Case 1 'column insert
MsgBox Application.UserName & " insert column"
Case 2 'column delete
MsgBox Application.UserName & " delete column"
End Select
End Sub
In einem Standardmodul:
Option Explicit
Private Const ERROR_REFERENCE As String = "#REF!"
Public Function CheckRows(ByRef probjWorksheet As Worksheet) As Integer
Const LOCAL_NAME As String = "LastRow"
Dim objName As Name
With probjWorksheet
For Each objName In .Names
If objName.Name = .Name & "!" & LOCAL_NAME Then
If objName.RefersTo = "=" & .Name & "!" & ERROR_REFERENCE Then
CheckRows = 1
ElseIf objName.RefersToRange.Row .Rows.Count Then
CheckRows = 2
End If
Exit For
End If
Next
.Names.Add Name:=LOCAL_NAME, RefersTo:= _
.Cells(.Rows.Count, 1), Visible:=False
End With
End Function
Public Function CheckColumns(probjWorksheet As Worksheet) As Integer
Const LOCAL_NAME As String = "LastColumn"
Dim objName As Name
With probjWorksheet
For Each objName In .Names
If objName.Name = .Name & "!" & LOCAL_NAME Then
If objName.RefersTo = "=" & .Name & "!" & ERROR_REFERENCE Then
CheckColumns = 1
ElseIf objName.RefersToRange.Column .Columns.Count Then
CheckColumns = 2
End If
Exit For
End If
Next
.Names.Add Name:=LOCAL_NAME, RefersTo:= _
.Cells(1, .Columns.Count), Visible:=False
End With
End Function
Du musst einmal Zeilen und Spalten löschen damit die notwendigen Namen gesetzt werden.
Gruß
Nepumuk