Mehrere "Worksheet_SelectionChange" als eins

[Peter Schuerer]

Hallo Zusammen (Claus),

XL2002.

Ich habe 6 Tabellen mit dem gleichen Makro, jeweils der Tabelle
zugeordnet. Wenn jetzt Änderungen anstehen muss ich die 6 gleichen
Makros ändern.

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 1 And ActiveCell.Value = "x" Then '=1 ist
Spaltennummer
ActiveCell.ClearContents
Else
If Target.Column = 1 Then
ActiveCell.FormulaR1C1 = "x"
End If
End If
End Sub

Gibt es eine Möglichkeit nur ein Makro unter "Module" zu erstellen und
es wird in jeder einzelnen Tabelle ausgeführt?

Hintergrund:
Wenn der Anwender in einer dieser 6 Tabellen im Bereich A5:A300 klickt,
soll ein "x" eingetragen werden (wenn noch nicht vorhanden). Wenn
bereits ein "x" vorhanden, soll es entfernt werden.

Danke und Gruß
Peter

P.S. Bleib bitte in dieser NG!!:-)

[Alexander Wolff]

Ein Muster, welches Du sicher auf Dein Problem umsetzen kannst:

In die Ereignis-Tabellen jeweils:

Private Sub Worksheet_Change(ByVal Target As Range)
WSChange Target
End Sub

In ein allgemeines Modul:

Sub WSChange(ByVal Target As Range)
'Eingaben in Spalte A umwandeln in Kehrwert
If Target.Column = 1 Then
Application.EnableEvents = False
Target = 1 / Target
Application.EnableEvents = True
End If
End Sub

[Alexander Wolff]

Abwandlung: Mit

Private Sub Worksheet_Change(ByVal Target As Range)
'Der Ereignis-Wrapper
Call WSChange(Target, ActiveSheet.Name)
End Sub

Sub WSChange(ByVal Target As Range, Blatt)
'Eingaben in Spalte A umwandeln in Kehrwert, aber für Tabelle1 halbiert
If Target.Column = 1 Then
Application.EnableEvents = False
Target = 1 / Target / IIf(Blatt = "Tabelle1", 2, 1)
Application.EnableEvents = True
End If
End Sub

kann das Ereignis pro Blatt trotzdem unterschiedlich agieren, obwohl der Code zentralisiert ist

[Claus Busch]

Hallo Peter,

Post by Peter Schuerer
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 1 And ActiveCell.Value = "x" Then '=1 ist
Spaltennummer
ActiveCell.ClearContents
Else
If Target.Column = 1 Then
ActiveCell.FormulaR1C1 = "x"
End If
End If
End Sub

du könntest deinen Code in
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
einfügen.
Dort musst du dann nur die entsprechenden Tabellenblätter angeben, bei
denen der Code nicht laufen soll, also z.B:
If ActiveSheet.Name = "Blabla" then exit sub


Mit freundlichen Grüßen
Claus

[Claus Busch]

Hallo Peter,

Post by Claus Busch
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

hier noch ein Nachtrag zur Vereinfachung des Codes:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub

Target = IIf(Target = "x", "", "x")

End Sub


Mit freundlichen Grüßen
Claus

[Peter Schuerer]

Hallo Claus und Alexander,

ich habe die Lösung von Claus genommen und es funktioniert wunderbar.

Danke Euch Beiden.

Mit freundlichen Grüßen
Peter

Post by Claus Busch
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Target = IIf(Target = "x", "", "x")
End Sub
Mit freundlichen Grüßen
Claus