Aktion bei Doppelklick in unterschiedliche Zellen

Hallo zusammen,
ich habe mir ein Auswertungstool für Reportingzwecke erstellt.
Dabei soll es in bestimmten Zellen Möglich sein, per Doppelklick ein Zeichen (einen Punkt "") zu generieren und bei einem erneuten Doppelklick wieder zu entfernen.
Dies soll aber nur ab zeile 5 in jeweils 2 Zeilen für die Spalten E bis BX funktionieren. Also in Zeile 5&6, 9&10, 13&4,... usw bis Zeile 126.
Das Blatt ist vor Eingabe geschützt und nach der Eingabe wieder.
Mit diesem Code klappt das soweit auch ganz gut:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E5:BX6,E9:BX10,E13:BX14,E17:BX18,E21:BX22,E25:BX26,
E29:BX30,E33:BX34,E37:BX38,E41:BX42,E45:BX46,E49:BX50,E53:BX54,
E57:BX58,E61:BX62,E65:BX66,E69:BX70,E73:BX74,E77:BX78,E81:BX82,
E85:BX86,E89:BX90,E93:BX94,E97:BX98,E101:BX102,E105:BX106,E109:BX110,
E113:BX114,E117:BX118,E121:BX122,E125:BX126")) Is Nothing Then
Me.Unprotect Password:="XXX"
If Target = "" Then
Target = ""
Else
Target = ""
End If
Me.Protect Password:="XXX"
Cancel = True
End If
End Sub

Jetzt kommt mein "Aber":
Das klappt nur bis zum 27. Eintrag (E109:BX110). Will ich weitere Zeilenpaare (Ranges)hinzufügen, bekomme ich eine Fehlermeldung:

Laufzeitfehler '1004':
Die Methode 'Range' für das Objekt'_Worksheet' ist fehlgeschlagen.

Jetzt habe ich es mir einfach gemacht, und den Code etwas verbastelt:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E5:BX6,E9:BX10,E13:BX14,E17:BX18,E21:BX22,E25:BX26,
E29:BX30,E33:BX34,E37:BX38,E41:BX42,E45:BX46,E49:BX50,E53:BX54,
E57:BX58,E61:BX62,E65:BX66,E69:BX70,E73:BX74,E77:BX78,E81:BX82,
E85:BX86,E89:BX90,E93:BX94,E97:BX98,E101:BX102,E105:BX106,E109:BX110"))
Is Nothing Then
Me.Unprotect Password:="XXX"
If Target = "" Then
Target = ""
Else
Target = ""
End If
Me.Protect Password:="XXX"
Cancel = True
End If
If Not Intersect(Target, Range("E113:BX114,E117:BX118,E121:BX122,E125:BX126")) Is Nothing Then
Me.Unprotect Password:="XXX"
If Target = "" Then
Target = ""
Else
Target = ""
End If
Me.Protect Password:="XXX"
Cancel = True
End If
End Sub

Damit funktionert es wunderbar, aber das ist je gepfuscht.
Mein Fragen:
- Warum kann ich nur 27 Ranges angeben?
- Wie kann man das eleganter lösen? (so dass ich es auch verstehe :D )
Danke im Voraus für Eure Eingaben :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sascha,
der Code von Hary ist natürlich noch besser.
Für den Blattschutz würde ich aber dann auf Userinterface zurückgreifen.
Im Workbook-Open-Event den Blattschutz setzen mit:

Private Sub Workbook_Open()
Worksheets("Tabelle1").Protect Password:="XXX", userinterfaceonly:=True
End Sub

Das Userinterfaceonly:=True bewirkt, dass trotz Blattschutz Änderungen durch ein Makro ausgeführt werden dürfen. So sparst du dir das ständige entsperren und wieder sperren des Blattes.
Der Code von Hary dann so, ohne Unprotect bzw. Protect.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column >= 2 And Target.Column = 5 And Target.Row

Und noch was: Wenn ein Problem gelöst ist, dann bitte nicht den Haken setzen. Lies dir mal durch was dort steht. Wenn du den Haken setzt, dann wird der Beitrag als offen - also ungelöst markiert.
Gruß Werner

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Long If Target.Row 126 Then Exit Sub If Target.Column 76 Then Exit Sub For i = 5 To 126 Step 4 If Target.Row = i Then Cancel = True If Target = "" Then Target = "" Exit For Else Target = "" Exit For End If End If Next i For i = 6 To 126 Step 4 If Target.Row = i Then Cancel = True If Target = "" Then Target = "" Exit For Else Target = "" Exit For End If End If Next i End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Long If Target.Row 126 Then Exit Sub If Target.Column 76 Then Exit Sub For i = 5 To 126 Step 4 If Target.Row = i Then Me.Unprotect Password:="XXX" Cancel = True If Target = "" Then Target = "" Exit For Else Target = "" Exit For End If End If Next i For i = 6 To 126 Step 4 If Target.Row = i Then Cancel = True If Target = "" Then Target = "" Exit For Else Target = "" Exit For End If End If Next i Me.Protect Password:="XXX" End Sub

Beliebteste Forumthreads (12 Monate)

Aktion bei Doppelklick in unterschiedliche Zellen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Aktion bei Doppelklick in unterschiedliche Zellen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread