Im unterstehende Code vom Tino die tadellos funktioniert werden Change Ereignis die im Klassemodul stehen für Tabelle 1 ausgeführt.
Meine Frage, wie kann man diese Code für mehrere Tabelle definieren und oder für komplette Arbeitsmappe code. Habs unterander probiert mit 'Set WS_Events.Event_WS = ActiveSheet aber ohne erfolg.
***DieseArbeitmappe***
Option Explicit
Private Sub Workbook_Open()
Set WS_Events.Event_WS = Tabelle1
'Set WS_Events.Event_WS = ActiveSheet
End Sub
***Klassemodul diese Code****Option Explicit
Public WithEvents Event_WS As Worksheet
Private Sub Event_WS_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strOrdner As String
If Target.Address "$B$1" Then Exit Sub
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
Cancel = True
Target = .SelectedItems(1)
End If
End With
End Sub
Private Sub Event_WS_Change(ByVal Target As Range)
Dim rngCell As Range
If Intersect(Target, Range("C6:C999")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rngCell In Intersect(Target, Range("C6:C999"))
If Len(rngCell) Then
With rngCell.Offset(, -2).Resize(1, 7)
With .Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Target.Interior.Color = RGB(216, 216, 216)
Else
With rngCell.Offset(, -2).Resize(1, 7).Borders
.LineStyle = xlNone
End With
Target.Interior.ColorIndex = xlNone
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
beispiel
https://www.herber.de/bbs/user/74265.xlsm
Grüße
Karel