Office: zweites doppelklick ereignis hinzufügen

wie erweitere ich dieses doppelklick eriegnis auch für die folgende aufgabe:

beim doppelklicken der zellen von a1:a34, d8:d36, e1:e7 wird die jeweilige zelle angekreuzt(bsp ein x)

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim RaBereich As Range                  ' Varable Bereich Wirksamkeit
    If Target.Count = 1 Then
        ' Bereich der Wirksamkeit
        Set RaBereich = Range("b1:b15, c5:c8, f8:f76")
        'ActiveSheet.Unprotect ("Passwort")  ' Schutz der Tabelle aufheben
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not Intersect(Target, RaBereich) _
            Is Nothing Then FRM_Kalender.Show
        'ActiveSheet.protect ("Passwort")    ' Schutz auf Tabelle setzen
        Set RaBereich = Nothing             ' Variable löschen
    End If
End Sub

 

Code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RaBereich As Range                  ' Varable Bereich Wirksamkeit
    If Target.Count = 1 Then
        ' Bereich der Wirksamkeit
        Set RaBereich = Range("b1:b15, c5:c8, f8:f76")
        'ActiveSheet.Unprotect ("Passwort")  ' Schutz der Tabelle aufheben
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not Intersect(Target, RaBereich) _
            Is Nothing Then FRM_Kalender.Show
        Set RaBereich = Range("a1:a34, d8:d36, e1:e7")
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not Intersect(Target, RaBereich) _
            Is Nothing Then Target = "x"
        'ActiveSheet.protect ("Passwort")    ' Schutz auf Tabelle setzen
        Set RaBereich = Nothing             ' Variable löschen
    End If
End Sub

 

Es ist mir eine Ehre, die Lösung von Dir zu erhalten Hajo.
Vielen Dank

 

ActiveCell.Offset(0, 1).Select
Hiermit sollte doch nach dem Doppelklickereignis Eins nach rechts ausgewählt werden.

Dies trifft dann aber auf alle Zellen zu. Egal welche Zelle ich zwei mal anklicke, dann springt der Cursor direkt eins nach rechts :)

Das ist ärgerlich. Wie sollte der Code aussehen, damit nach dem Doppelklick nur von der Zelle bewegt wird, in der das Makro auch ausgeführt wird?

 

Hallo!

Deine Erklärung ist richtig, aber ich kann diesen Befehl weder in deinem noch in Hajo's Code entdecken...

Dann muss diese Zeile zwischen das "If" und das "End If", welches den Wirkungsbereich festlegt.

 

Hallo Schatzi,
vielen Dank für deinen Lösungsvorschlag.

Habe den Code an jeder möglichen Zelle schon ausprobiert.
Egal wo, es funktioniert überall und nicht etwa nur für RaBereich :D

Code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RaBereich As Range                  ' Varable Bereich Wirksamkeit
    If Target.Count = 1 Then
        ' Bereich der Wirksamkeit
        Set RaBereich = Range("b1:b15, c5:c8, f8:f76")
        'ActiveSheet.Unprotect ("Passwort")  ' Schutz der Tabelle aufheben
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not Intersect(Target, RaBereich) _
            Is Nothing Then FRM_Kalender.Show
        Set RaBereich = Range("a1:a34, d8:d36, e1:e7")
        ' prüfen ob Zelle im Bereich, dann Userform starten

ActiveCell.Offset(0, 1).Select 

        If Not Intersect(Target, RaBereich) _
            Is Nothing Then Target = "x"
        'ActiveSheet.protect ("Passwort")    ' Schutz auf Tabelle setzen
        Set RaBereich = Nothing             ' Variable löschen
    End If
End Sub 

 

ich hätte den Code vieleicht anders geschrieben.

Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RaBereich As Range                  ' Varable Bereich Wirksamkeit
    If Target.Count = 1 Then
        ' Bereich der Wirksamkeit
        Set RaBereich = Range("b1:b15, c5:c8, f8:f76")
        'ActiveSheet.Unprotect ("Passwort")  ' Schutz der Tabelle aufheben
        Set RaBereich = Intersect(RaBereich, Range(Target.Address))
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not RaBereich Is Nothing Then
            MsgBox "Useform"
 '           FRM_Kalender.Show
        End If
        Set RaBereich = Range("a1:a34, d8:d36, e1:e7")
        Set RaBereich = Intersect(RaBereich, Range(Target.Address))
        ' prüfen ob Zelle im Bereich, dann Userform starten
        If Not RaBereich Is Nothing Then
            Target = "x"
        End If
        'ActiveSheet.protect ("Passwort")    ' Schutz auf Tabelle setzen
        Set RaBereich = Nothing             ' Variable löschen
    End If
End Sub

 

Lieber Hajo,

vielmals bedanke ich mich für deine Lösungen in Foren.

http://hajo-excel.de

Stand: 25.03.2011

• Besucher gesamt: 357.334
  Max. Besucher pro Tag: 495
  max. online: 33
  Seitenaufrufe gesamt: 1.601.793

http://www.office-hilfe.com
Beiträge insgesamt: 1676
http://www.ms-office-forum.net
Beiträge: 689

Hätten wir Hajo Ziplies nicht in Foren, wären wir nur Einzeller!