Thema: Makro in aktueller Zelle ausführen mit Doppelklick

Hallo,
ich möchte gerne, dass ich bei Doppelklick in einer Zelle ein Makro ausführe, dass mir, wie in meiner Beispieldatei zu sehen, die Auswahl mit einem transparenten Kreis Symbol kennzeichnet, also um die Auswahl dieser Antwort zu kennzeichnen.
Ich kenne mich mit der Programmierung/Erstellung von Makros leider nicht aus und hoffe, dass mir hier jemand helfen kann ;).

Beispiel:



Schon mal vielen Dank für eure Unterstützung!

Gruß
Klaus

Zu kompliziert. Färbe lieber die Zelle, ist viel einfacher.

Hallo Klaus,

rechtsklicke auf dem Reiter von deinem Excel-Blatt und wähle "Code anzeigen". So bist Du in dem Codepane des Blatt-Objekt. Im Fenster-Leiste sollte die Beschriftung mit "[Tabelle1 (Code)]" (oder ähnlichen) am Ende stehen.

Oben links, wo "(Allgemein)" steht, schalte aus "Worksheet", dann rechts davon, wo jetzt "SelectionChange", schalte auf "BeforeDoubleClick".

Jetzt hast Du den Rumpft einer Ereignisprozedure, die ausgelöst wird, wenn in einer Zelle dieses Blattes Dopppelgeklickt wird.

In diese Prozdure, füge folgende Code ein:

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

    Cancel = True

    MsgBox "Zelle " & Target.Address & " wurde doppelgeklickt."

End Sub

Jetzt gehe wieder in das Blatt und Doppelklick auf einer Zelle.
Gehe auf eine andere Blatt und doppelklick dort auf einer Zelle. Die Ereignis gilt nur für das Blatt, wo der Code definiert ist. Solltest Du etwas für alle Blätter haben wollen, melden.

Jetzt gehst Du wieder auf dem Blatt, starte die Makroaufzeichnung (im Menü "Entwicklertools"), führe die Aktion, die passieren soll, wenn doppelgeklickt wird. Aufzeichnung stoppen.
Mit Alt+F11 in VisualBasic-Editor gehen und dort auf "Module1". Der gerade aufgezeichnete Code ist da sichtbar.

Es wird so aussehen:

Sub Makro1()

'

' Makro1 Makro

'



'

    ActiveCell.FormulaR1C1 = "abcd"

    Range("G9").Select

End Sub

andere es in

Sub MeinDoppelklickAktion(ByVal Target As Range)

' ich beschreibe was hier passiert

    

    Target.FormulaR1C1 = "abcd"

End Sub

b

oder ähnliches. Wichtig ist, dass Du die Zelle, die während der Aufzeichnung festgelegt wurde durch eine Zelle "Target", die als Parameter weitergegeben wird.
Wechsle in der Codepane des Blattes, wo "Worksheet_BevorDoubleClick" definiert wurde und andere den Code in:

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

    Cancel = True

    MeinDoppelklickAktion Target 

End Sub

Dann nochmal testen.

VG
Yal

Hallo Yal,
danke für deinen Support. Habe ich grundsätzlich verstanden. Nur die Zuordnung mit target nicht ;) Bei meinem Test habe ich ein Makro erzeugt, dass mir ein transparentes Dreieck einfügt (siehe Beispiel). Wie muss ich jetzt z.B. diesen Code ändern, dass das Dreieck in der Zelle eingefügt wird, die ich doppelt klicke? Und wie kann ich die Größe der form beeinflussen? Ich nehme an, dass ich das schon bei der Makroaufzeichnung erledigen muss ...?!

Hi,

das ist eine klassische Aufgabe für die Bedingte Formatierung.
Entweder fügst Du für jede Bewertung eine Zeile darunter ein oder Du lässt per Dropdown bewerten (und färbst abhängig davon).

Beide Varianten mal anbei.

https://www.herber.de/bbs/user/169028.xlsx

VG, Boris

Hallo Klaus

teste mal

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



  Dim shp As Shape

  Dim iAbst As Integer

  

  iAbst = 1     'Abstand zum seitl. Zellrand - bei Bedarf ändern

  Cancel = True

  

  '***Kreis löschen, wenn vorhandenen

  For Each shp In ActiveSheet.Shapes

    If shp.TopLeftCell.Address = Target.Address Then

      shp.Delete

      Exit Sub

    End If

  Next

  Application.ScreenUpdating = False

  

  '***Kreis einfügen

  ActiveSheet.Shapes.AddShape(msoShapeOval, 0, 0, 20, 20).Select

  

  '***Kreis in aktive Zelle verschieben und anpassen

  With Selection.ShapeRange

    .Width = Target.Width - 2 * iAbst

    .Height = .Width

    .Top = Target.Top + (Target.Height - .Height) / 2

    .Left = Target.Left + iAbst

    .Fill.Visible = msoFalse

    .Line.ForeColor.RGB = RGB(0, 176, 240) 'Hellblau

    .Line.Weight = 2.25

  End With

  Target.Select

End Sub

gemäß Deines Bildes ist eine Zelle höher als breit, deshalbhab ich die Kreisgröße auf die Zellbreite bezogen und dann mittig angeordnet.

Das Tabellenblatt, in dem der Code ausgeführt werden soll, im VBA-Explorer doppelklicken und den Code ins rechte Fenster kopieren.

Gruß Rolf

Hallo Rolf,
das funktioniert hervorragend! Vielen Dank!
Ist es machbar, dass ich die Markierung nach erneutem Doppelklick, wieder rückgängig machen kann?

Gruß
Klaus

Hallo Klaus,

probiers doch einfach mal ;-)

Gruß Rolf

Danke Rolf, du hast recht ... einfach mal probieren :)
Nochmals vielen Dank!

Gruß
Klaus

Hallo Rolf,

wie muss ich dem Code ändern, dass in den Spalten K,L,M,N,O der Kreis nach Doppelklick grün wird?

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

Dim shp As Shape
Dim iAbst As Integer

iAbst = 1 'Abstand zum seitl. Zellrand - bei Bedarf ändern
Cancel = True

'***Kreis löschen, wenn vorhandenen
For Each shp In ActiveSheet.Shapes
If shp.TopLeftCell.Address = Target.Address Then
shp.Delete
Exit Sub
End If
Next
Application.ScreenUpdating = False

'***Kreis einfügen
ActiveSheet.Shapes.AddShape(msoShapeOval, 0, 0, 20, 20).Select

'***Kreis in aktive Zelle verschieben und anpassen
With Selection.ShapeRange
.Width = Target.Width - 2 * iAbst
.Height = .Width
.Top = Target.Top + (Target.Height - .Height) / 2
.Left = Target.Left + iAbst
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = RGB(0, 176, 240) 'Hellblau
.Line.Weight = 2.25
End With
Target.Select
End Sub

Danke ;)

Gruß
Klaus

Gruß Rolf

Hallo Rolf,

in den Spalten K,L,M,N,O sollten die Kreise in den Zellen grün sein ...
wie kann ich diese Bedingung im Code formulieren?



LG

Klaus

Könnte man auch per Doppelklick.