Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 10:13:05
Excel Tabelle - Ort/Stadt nur einmal pro Kunde zählen?
17.05.2024 09:40:47
Warum geht das Fenster aktualisieren auf
17.05.2024 09:18:12
Autofilter mit Copy Funktion bei mehr als 158 Zeilen
17.05.2024 08:39:33
Fehler bei: BlattBereich als .jpg in andere .xlsm kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1956to1960
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kreuz in Zelle setzen

Kreuz in Zelle setzen
30.12.2023 14:22:52
Micha
Hallo
Ich habe hier diesen code mit dem ich mit der rechten Maustaste Zellen Markieren kann.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect Password:="merlin"
If Not Intersect([D4:AH4,D7:AF7,D10:AH10,D13:AG13,D16:AH16,D19:AG19,D22:AH22,D25:AH25,D28:AG28,D31:AH31,D34:AG34,D37:AH37], Target) Is Nothing Then
If Target.Interior.ColorIndex = 3 Then
Target.Interior.ColorIndex = x1None
Else
Target.Interior.ColorIndex = 3
End If
Cancel = True
ActiveSheet.Protect Password:="merlin"
End If
End Sub

Jetz brüchte ich noch einen das wenn ich in eine Zelle klicke ein Kreuz gesetzt wird. Habe es mit dem Recorder Aufgezeichnet bekomme es aber nicht umgesetzt.
Könnte mir da jemand helfen?

Mfg Micha

Sub Kreuz()
Kreuz Makro
Range("C3").Select
With Selection.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Color = -1003520
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Color = -1003520
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kreuz in Zelle setzen
30.12.2023 14:54:28
ralf_b
naja ein Kreuz in die Zelle setzt du nicht, du setzt dort Rahmenlinien.
ich würde das nicht per klick machen, eher per Doppelklick oder etwas was man "nicht" bei der regelmäßigen Tabellenarbeit benutzt.

Soll das vielleicht mit in den Rechtsklick mit rein?
AW: Kreuz in Zelle setzen
30.12.2023 15:55:26
Uduuh
Hallo,
was bekommst du nicht umgesetzt?
Prinzipiell reicht 
Sub KreuzAnAus()

  With Selection

    .Borders.LineStyle = xlNone

    With .Borders(xlDiagonalDown)

      .LineStyle = -.LineStyle - 4141

    End With

    With .Borders(xlDiagonalUp)

      .LineStyle = -.LineStyle - 4141

    End With

  End With

End Sub

Gruß aus'm Pott
Udo
Anzeige
AW: Kreuz in Zelle setzen
31.12.2023 08:49:16
RPP63
Moin und nur ergänzend!
Du solltest unbedingt Option Explicit an den Anfang jedes Moduls setzen.
Dies kann man auch dauerhaft in den Optionen des Editors festlegen:


Begründung:
Du schreibst x1None, richtig ist aber xlNone (L statt 1)!
Dies klappt nur rein zufällig in Deinem Rechtsklick-Code, weil die nicht deklarierte Variant-Variable x1None nicht gefüllt ist.
Die Excel-VBA-Konstante xlNone hingegen entspricht dem Wert -4142

Two Cents
Ralf
AW: Kreuz in Zelle setzen
31.12.2023 09:59:41
Micha
Hi
Vielen dank für die Antwort.
Aber ich bekomme es immer noch nicht hin das ich die Diagonalen mit einem Klick in bestimmte Bereiche setzen kann.
Eigentlich so wie der Code mit dem Rechtsklick. Anstatt die Farbe sollten dann die Diagonalen gesetzt werden.

Mfg Micha
Anzeige
AW: Kreuz in Zelle setzen
31.12.2023 10:21:37
Crazy Tom
moin

wenn es denn unbedingt so gewünscht ist 

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

ActiveSheet.Unprotect Password:="merlin"

    If Not Intersect([D4:AH4,D7:AF7,D10:AH10,D13:AG13,D16:AH16,D19:AG19,D22:AH22,D25:AH25,D28:AG28,D31:AH31,D34:AG34,D37:AH37], Target) Is Nothing Then

        Cancel = True

        With Target

            .Borders.LineStyle = xlNone

            With .Borders(xlDiagonalDown)

                .LineStyle = -.LineStyle - 4141

            End With

            With .Borders(xlDiagonalUp)

                .LineStyle = -.LineStyle - 4141

            End With

        End With

    End If

ActiveSheet.Protect Password:="merlin"

End Sub


mfg Tom
Anzeige
AW: Kreuz in Zelle setzen
31.12.2023 10:29:36
Micha
Hi
danke für die schnelle Antwort. So sollte es sein.
Wie bekomme ich die Linien noch Farbig und Dick hin?

Mfg Micha
AW: Kreuz in Zelle setzen
31.12.2023 11:12:09
Micha
Hi
Die Linien werden jetzt in der Dicke und Farbe gesetzt. Aber beim erneuten Rechtsklick werden sie aber nicht entfernt.
Was muss ich da noch Einfügen?

Mfg Micha

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveSheet.Unprotect Password:="merlin"
If Not Intersect([D4:AH4,D7:AF7,D10:AH10,D13:AG13,D16:AH16,D19:AG19,D22:AH22,D25:AH25,D28:AG28,D31:AH31,D34:AG34,D37:AH37], Target) Is Nothing Then
Cancel = True
With Target
.Borders.LineStyle = xlNone

With .Borders(xlDiagonalDown)
.LineStyle = -.LineStyle - 4141
.Weight = xlThick
.Color = -1003520

End With
With .Borders(xlDiagonalUp)
.LineStyle = -.LineStyle - 4141
.Weight = xlThick
.Color = -1003520

End With
End With
End If
ActiveSheet.Protect Password:="merlin"
End Sub

Anzeige
AW: Kreuz in Zelle setzen
31.12.2023 11:45:27
Crazy Tom
vielleicht so? 

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

ActiveSheet.Unprotect Password:="merlin"

    If Not Intersect([D4:AH4,D7:AF7,D10:AH10,D13:AG13,D16:AH16,D19:AG19,D22:AH22,D25:AH25,D28:AG28,D31:AH31,D34:AG34,D37:AH37], Target) Is Nothing Then

        Cancel = True

        With Target

            If .Borders(xlDiagonalDown).LineStyle = xlContinuous Then

                .Borders(xlDiagonalDown).LineStyle = xlNone

                .Borders(xlDiagonalUp).LineStyle = xlNone

            Else

                With .Borders(xlDiagonalDown)

                    .Weight = xlThick

                    .Color = -1003520

                End With

                With .Borders(xlDiagonalUp)

                    .Weight = xlThick

                    .Color = -1003520

                End With

            End If

        End With

    End If

ActiveSheet.Protect Password:="merlin"

End Sub


mfg Tom
Anzeige
AW: Kreuz in Zelle setzen
31.12.2023 11:54:17
Micha
Vielen vielen Dank für deine Hilfe.
Genau so sollte es sein.
Danke danke danke

Mfg Micha
AW: Kreuz in Zelle setzen
30.12.2023 20:00:11
Micha
Hi
danke für die Antwort.
Es sollte aber sein, wenn ich in eine bestimmte Zelle anklicke das dort die diagonalen striche sind.
Wie in dem Code mit der rechten Maustaste wo die Farben gesetzt werden.

Mfg Micha
AW: Kreuz in Zelle setzen
30.12.2023 21:39:30
Uduuh
Hallo,
dann im Klassenmodul der Tabelle: 


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  With Target

    .Borders.LineStyle = xlNone

    With .Borders(xlDiagonalDown)

      .LineStyle = -.LineStyle - 4141

    End With

    With .Borders(xlDiagonalUp)

      .LineStyle = -.LineStyle - 4141

    End With

  End With

End Sub

Gruß aus'm Pott
Udo
Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige