ja nein mit einem Klick

Question

Hallo,

wie kann ich per Mausklick in einer Zelle einen Haken (also Wahrheitswert) setzen?

Formular - Steuerelemente wären optimal (Kontrollkästchen), die muss ich aber immer einzeln mit den Zellen verknüpfen.

In der Tabelle sollen Eigenschaften "abgehakt" bzw. als überprüft gekennzeichnet werden.

Vielleicht kann mir jemand helfen :)

Answer 1

Hi happy1998 ^^

Wie gewünscht :-)

Gruss Nighty

Einzufügen
Alt+F11/Projektexplorer/DeineTabelle

Target.Column = 6

steht für Spalte F,entsprechend anpassen

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 6 And Target.Row > 1 Then
Cells(Target.Row, Target.Column).Font.Name = "Marlett"
Cells(Target.Row, Target.Column) = Chr$(97)
End If
End Sub

Answer 2

Hi All ^^

Oder in Wechselwirkung :-)

Gruss Nighty

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 6 And Target.Row > 1 Then
If Cells(Target.Row, Target.Column) = Chr$(97) Then
Cells(Target.Row, Target.Column) = ""
Else
Cells(Target.Row, Target.Column).Font.Name = "Marlett"
Cells(Target.Row, Target.Column) = Chr$(97)
End If
End If
End Sub

Answer 3

Hi happy1998 ^^

Oder das Selectiosereigniss
ein Mausclick!

Gruss Nighty

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 6 And Target.Row > 1 Then
If Cells(Target.Row, Target.Column) = Chr$(97) Then
Cells(Target.Row, Target.Column) = ""
Else
Cells(Target.Row, Target.Column).Font.Name = "Marlett"
Cells(Target.Row, Target.Column) = Chr$(97)
End If
End If
Application.EnableEvents = True
End Sub

Answer 4

Hallo,

mit folgenden Code kannst du beliebig viele Kontrollkästchen in Spalten deiner
Wahl erzeugen.

Aktuelle Einstellung:
C6 bis C10
Verknüpfte Cellen:
D6 bis D10

Passe den Code so an, wie du ihn brauchst.

Sub Checkbox_einfügen()
Dim stCheckBox As CheckBox, intI As Integer
For intI = 6 To 10
Set stCheckBox = ActiveSheet.CheckBoxes.Add _
(Cells(intI, 3).Left, Cells(intI, 5).Top, Cells(intI, 5).Width, Cells(intI,
5).Height)
stCheckBox.LinkedCell = Cells(intI, 4).Address
Next
End Sub

Gruß
Rainer

Answer 5

Hallo - danke erst mal !

Kenne mich leider mit Makros nicht aus.

Wenn ich z.B. die Makrobefehle von Nighty eingebe, muss ich erst mal das Makro erstellen und dann kommt folgendes raus :

funktioniert aber nicht - ich muss den Makronamen irgendwie vorher definieren - oder


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 6 And Target.Row > 1 Then
If Cells(Target.Row, Target.Column) = Chr$(97) Then
Cells(Target.Row, Target.Column) = ""
Else
Cells(Target.Row, Target.Column).Font.Name = "Marlett"
Cells(Target.Row, Target.Column) = Chr$(97)
End If
End If
Application.EnableEvents = True
End Sub

Sub test()

End Sub

Answer 6

Hi All ^^

Hier eine Beispieldatei?

Gruss Nighty

Bereich des Hakens setzen/löschen

Tabelle1
C2 bis C & Rows.Count

Makro ist Zertifiziert

Mappe ansonsten Sauber,daher weiter benutzbar!

Alt+F11/Projektexplorer/Tabelle1 doppelclick siehst du das Makro

www.file-upload.net/download-12061736/Beispiel.xls.html

Answer 7

Hi all ^^

Erste Link nicht anclicken,zu mysterios der Anbieter!

Gruss Nighty

Neuer Versuch
filehorst.de/d/bwJDJqDi

Answer 8

@happy98

anbei ein Beispiel.

Per Doppelklick kannst du in einer beliebigen Zelle ein Kontrollkästchen erzeugen und
dieses gleichzeitig mit dieser Zelle verknüpfen.

dl=0">Download

Gruß
Rainer

Answer 9

Hallo Zusammen,

super vielen Dank !! :)

Bin begeistert

Frage an Nighty:

Wie kann ich denn mehrere Spalten definieren? Also C und D und N oder so....


If Target.Column = 3





Bei der Datei von Rainer kann ich in alle Zellen nur noch Haken setzen?!

Answer 10

Hi happy1998:-)

Wie gewünsct ^^
Spalte C + D + N ab Zeile 2

Oder auch Bereiche
Ersetze

Range("C2:C" & Rows.Count)

Durch

Range("C2:C5")

z.b.
etc.

Gruss Nighty

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim DeineBereiche As Range
Set DeineBereiche = Union(Range("C2:C" & Rows.Count), Range("D2:D" & Rows.Count), Range("N2:N" & Rows.Count))
If Not Intersect(Target, DeineBereiche) Is Nothing Then
If Cells(Target.Row, Target.Column) = Chr$(97) Then
Cells(Target.Row, Target.Column) = ""
Else
Cells(Target.Row, Target.Column).Font.Name = "Marlett"
Cells(Target.Row, Target.Column) = Chr$(97)
End If
End If
Application.EnableEvents = True
End Sub