Rechte Maustaste, Zellen zustand mehrfach ändern mit VBA

[Niko]

Hallo an alle,

habe den unterliegenden VBA Code seit langem irgendwo aus dem Internet.
Er funktioniert ohne Probleme, doch ich möchte fragen ob er erweiterbar ist.

Zur Zeit ist im Code:       

 Target = IIf(Target = "", "Eintrag", "Kein Eintrag")

Drei zustände mit klicken der rechte Maus, der Reihe nach, möchte aber noch zwei zustände zusätzlich hinzufügen.

Bespiel, anstatt:
        Target = IIf(Target = "", "Eintrag", "Kein Eintrag")
Sollte es:
        Target = IIf(Target = "", "Eintrag", "Kein Eintrag", “Fast Eintrag“, ““ )

…ist es möglich mehrere zustände hinzuzufügen oder mit anderen Code es zu bewerkstelligen?
habe es mit einfachen ändern der oberen programm Zeile versucht, doch da kommt error .

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Me.Unprotect ("1234")

    If Not Intersect(Target, Range("AA10:AC1009")) Is Nothing Then
        Target = IIf(Target = "", "Eintrag", "Kein Eintrag")
        Cancel = True
    End If
   
    End If
    Me.Protect ("1234")
End Sub

Danke im Voraus,

Niko

[volti]

Hallo Niko,

meinst Du so etwas hier:

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)

  Me.Unprotect ("1234")

  If Not Intersect(Target, Range("AA10:AC1009")) Is Nothing Then
     Select Case Target.Value
     Case "Eintrag":      Target.Value = "Kein Eintrag"
     Case "Kein Eintrag": Target.Value = "Fasteintrag"
     Case "Fasteintrag":  Target.Value = ""
     Case "":             Target.Value = "Eintrag"
     End Select
     Cancel = True
  End If

  Me.Protect ("1234")
End Sub

viele Grüße
Karl-Heinz

[Niko]

Vielen dank 
 ...doch es funktioniert nicht, Maus Cursor dreht sich, es kommt kein Fehler auf doch kein Text in der rechts angeklickten Zelle.
 
Habe es auf ein neues Blatt probiert sowie auf das vorhandene, das selbe Ergebnis wie oben beschrieben.
Was mache ich falsch?



Thx 
Niko

[volti]

Hallo Niko,

eine Anpassung...

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)

  Me.Unprotect ("1234")

  If Not Intersect(Target, Range("AA10:AC1009")) Is Nothing Then
     Select Case Target.Value
     Case "Eintrag":      Target.Value = "Kein Eintrag"
     Case "Kein Eintrag": Target.Value = "Fasteintrag"
     Case "Fasteintrag":  Target.Value = ""
     Case Else:           Target.Value = "Eintrag"
     End Select
     Cancel = True
  End If

  Me.Protect ("1234")
End Sub

viele Grüße
Karl-Heinz

[Niko]

Ein träumchen...Danke