per Doppelklick Wert / Zeichen i.e. Zelle einfügen

Hallo Allerseits,
Folgendes Code habe ich irgendwo aus dem Netz genommen um ein Häckchen einzufügen.
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
If Intersect(Target, Union(Range("A4:J11"), Range("A14:J21"))) Is Nothing Then Exit Sub 
With Target(1) 
    .Font.Name = "Wingdings" 
.Font.Size = 14
.HorizontalAlignment = xlCenter
  .Value = IIf(.Value = "ü", "", "ü") 
    Cancel = True 
End With 
End Sub

Das funktioniert einwandfrei
Ich habe folgende Zeile geändert:
.Value = IIf(.Value = "ü", "û", "ü")
um einen X zu bekommen. Allerdings kann ich damit nicht mehr bei einem Doppelklick, dass die Zelle geleert wird. Bei den Versuch einen vierten Wert hinzuzufügen, kommt eine Fehlermeldung, die ich gar nicht nachvollziehen kann, da meine VBA Kenntnisse Richtung Null gehen.
Frage 1: Wer kann mir helfen den Code so zu ändern, damit die Zelle geleert werden kann? Also so zu sagen 3 Fälle. Häckchen, Kreuz, Leer beim Doppelklick eingefügt werden kann.
Frage 2: Ich möchte in eine andere Spalte ähnliche Funktion haben, dass ich in eine andere Spalte andere Zeichen "---", "+++" sich einfügen bei einem Doppelklick? Kann man das in dem gleichen Makro machen und wenn ja, wie geht das?
Vielen Dank für die Hilfe im Voraus.
liebe Grüße,
Lilli :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A14:J21")) Is Nothing Then Exit Sub With Target .Font.Name = "Wingdings" .Font.Size = 14 .HorizontalAlignment = xlCenter If .Value = "" Then .Value = "ü" ElseIf .Value = "ü" Then .Value = "û" ElseIf .Value = "û" Then .Value = "" End If Cancel = True End With End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A14:J21")) Is Nothing Then Exit Sub With Target .Font.Name = "Wingdings" .Font.Size = 14 .HorizontalAlignment = xlCenter If .Value = "" Then .Font.Color = -11489280 .Value = "ü" ElseIf .Value = "ü" Then .Font.Color = -16776961 .Value = "û" ElseIf .Value = "û" Then .Font.Color = 1 .Value = "" End If Cancel = True End With

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim x As Long Dim arrZeichen Dim arrFarbe If Not Intersect(Target, Range("A1:A10")) Is Nothing Then arrZeichen = Array("", "ü", "û") arrFarbe = Array(vbWhite, vbGreen, vbRed) ElseIf Not Intersect(Target, Range("B3:F9")) Is Nothing Then arrZeichen = Array("---", "+++", "") arrFarbe = Array(vbYellow, vbBlue, vbWhite) Else Exit Sub End If On Error Resume Next x = WorksheetFunction.Match(Target.Value & "", arrZeichen, 0) On Error GoTo 0 x = x Mod (UBound(arrZeichen) + 1) Target.Value = arrZeichen(x) Target.Font.Color = arrFarbe(x) Cancel = True End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim x As Long Dim arrZeichen Dim arrFarbe Dim arrSchriftart If Not Intersect(Target, Range("A1:A10")) Is Nothing Then arrSchriftart = Array("Calibri", "Wingdings","Wingdings") arrZeichen = Array("", "ü", "û") arrFarbe = Array(vbWhite, vbGreen, vbRed) ElseIf Not Intersect(Target, Range("B3:F9")) Is Nothing Then arrSchriftart = Array("Calibri", "Calibri","Calibri") arrZeichen = Array("---", "+++", "") arrFarbe = Array(vbYellow, vbBlue, vbWhite) Else Exit Sub End If On Error Resume Next x = WorksheetFunction.Match(Target.Value & "", arrZeichen, 0) On Error GoTo 0 x = x Mod (UBound(arrZeichen) + 1) Target.Value = arrZeichen(x) Target.Font.Color = arrFarbe(x) Target.Font.Name = arrSchriftart(x) Cancel = True End Sub

Beliebteste Forumthreads (12 Monate)

per Doppelklick Wert / Zeichen i.e. Zelle einfügen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

per Doppelklick Wert / Zeichen i.e. Zelle einfügen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread