Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code erweitern

Forumthread: Code erweitern

Code erweitern
03.02.2023 14:10:26
Jörg
Hallo zusammen
Ich möchte folgenden Code erweitern.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
i = Range("d7").Interior.ColorIndex
Range("c6:e9").Interior.ColorIndex = i
End Sub
Zielsetzung ist: Wenn ich eine Zelle auswähle, sollen die Zellen darum mit eingefärbt werden.
Beispiel: J7=I6:K9, P71=O70:Q73
Danke
Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code erweitern
03.02.2023 14:17:48
ChrisL
Hi
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range(Cells(WorksheetFunction.Max(Target.Row - 1, 1), WorksheetFunction.Max(Target.Column - 1, 1)), Cells(Target.Row + 1, Target.Column + 1)).Interior.ColorIndex = Target.Interior.ColorIndex
End Sub
cu
Chris
Anzeige
AW: Code erweitern
03.02.2023 14:56:57
Jörg
Vielen Dank, es funktioniert soweit.
Aber wenn ich jetzt eine andere Zelle anklicke, löscht es die Hintergrundfarbe raus.
Mein Ziel ist es , eine Zelle auszuwählen und über einen Button färbe ich diese.
Beim verlassen der Zelle sollen sich die Nachbarzellen einfärben.
AW: Code erweitern
03.02.2023 15:19:03
ChrisL
Hmm so ganz blicke ich nicht durch. Der Code "löscht" keine Farben und von einem Button war bisher nicht die Rede.
Ich könnte mir vorstellen, dass du sowas ähnliches wie ein "Fadenkreuz" programmieren willst:
https://www.google.com/search?q=fadenkreuz+farbe+site%3Awww.herber.de
Anzeige
AW: Code erweitern
03.02.2023 16:42:20
Jörg
Hallo
Ich habe mal eine Beispieldatei hochgeladen
https://www.herber.de/bbs/user/157629.xlsm
Ich möchte das Feld z.B. D7 markieren und mit dem "Farbeimer" in Spalte B füllen.
Wenn ich die Zelle verlasse , sollen die Felder C6 bis E9 mit der Farbe gefüllt werden.
Die Zelle, die markiert wird, ist D7; D11, D15, G7, G11, G15 usw.
Es soll auch eine Mehrfachzuordnung sein.
Also eine Farbe für mehrere Felder.
Anzeige
AW: Code erweitern
03.02.2023 16:50:00
ChrisL
offen markiert... weil ich gleich im Wochenende bin und weil ich sowieso keine Makrodateien runterladen kann
AW: Code erweitern
03.02.2023 14:23:35
dirk
z.B. so:
Du musst aber aufpassen/abgrenzen, dass nicht in die erste Zeile oder Spalte geklickt wird!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim colourThis As Range
'nur Zelle oben links wählen
Set rng = Target.Areas(1).Cells(1)
'Wunschbereich definieren
Set colourThis = Range(rng.Offset(-1, -1), rng.Offset(1, 1))
'Einfärben
colourThis.Interior.ColorIndex = rng.Interior.ColorIndex
End Sub

Anzeige
AW: Code erweitern
03.02.2023 23:48:22
Piet
Hallo
Sorry, warum der Umweg eine Zelle zweimal zu markieren? Das geht doch in einem Rutsch!!
MergeZelle anklicken, Farbeimer drücken - Fertig!! - Noch Fragen ...?
https://www.herber.de/bbs/user/157634.xls
Voraustzung ist, das die linke obere Ecke des Farbeimers nicht in die Zelle davor hineinragt!
Dann kommt ein falscher Farbcode! Die Grafiken musst du bitte selbst korrekt ausrichten.
Mein Beispiel ist eine alte Excel 2003 Version, weil ich nur einen XP Laptop zur Verfügung habe.
mfg Piet
Anzeige
AW: Code erweitern
04.02.2023 17:42:03
Jörg
Hallo Piet
Vielen, vielen Dank, es funktioniert fast so, wie ich es mir vorgestellt habe.
Das einzige Manko ist noch, das bei Mehrfachauswahl nur der letzte markierte Bereich gefärbt wird.
Schönes Wochenende
AW: Code erweitern
05.02.2023 02:31:51
Piet
Hallo Jörg
das Manko wird wohl bleiben, denn wir haben es mit verbundenen Zellen zu tun.
Einen MergeArea Bereich kann ich auslesen, bei Mehrfachauswahl klappt das leider nicht.
mfg Piet
Anzeige
AW: Code erweitern
05.02.2023 02:36:49
Piet
Nachtrag
meinst du eine Mehrfachauswahl über mehrere Spalten? Oder Zeilen? Wenn ja wieviele?
Dafür habe ich keine Lösung parat, aber ggf. faellt mir ja doch nach was dazu ein.
mfg Piet
AW: Code erweitern
06.02.2023 08:29:22
Jörg
Morgen Piet
Es werden immer die verbundenen Zellen (D7:E8; D11:E12; G6:H7 usw.) ausgewählt.
Hintergrund ist, dass die Mitarbeiter mit den selben Farben an diesem Tag zusammenarbeiten und derjenige, dessen Farbe es ist, die Verantwortung für die Arbeit hat.
Bin da für jede Lösung offen.
Anzeige
AW: Code erweitern
06.02.2023 13:45:04
Piet
Hallo Jörg
interessante Aufgabe, mal schauen ob mir die Lösung gelungen ist?
Bedingung ist, das NUR die verbundenen Zellen selektiert werden, nicht der ganze Bereich!
mfg Piet
  • Sub Objekt_beKlick()
Dim BerAdr, Farbe, j As Integer
BerAdr = Split(Selection.Address, ",")
For j = 0 To UBound(BerAdr)
If Range(BerAdr(j)).Cells(1, 1).MergeArea.Cells.Count = 4 Then
   Objname = Application.Caller
   Farbe = ActiveSheet.Shapes(Objname).TopLeftCell.Interior.ColorIndex
   Adr = Range(BerAdr(j)).Cells(1, 1).Offset(-1, -1).Address
   Range(Adr).Resize(4, 3).Interior.ColorIndex = Farbe
End If
Next j
End Sub

    • Anzeige
    AW: Code erweitern
    06.02.2023 14:00:15
    Jörg
    Hallo Piet,
    dir ist die Aufgabe perfekt gelungen.
    Jetzt funktioniert es so, wie ich es mir vorgestellt hatte.
    Ich bin dir sehr dankbar.
    MfG Jörg
    ;

    Beliebteste Forumthreads (12 Monate)

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