Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
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
Inhaltsverzeichnis

Bereich Zellen Färben mit Farbwahl

Bereich Zellen Färben mit Farbwahl
25.01.2017 23:18:28
MaBlu
Hallo zusammen
ich habe im Web nach Zellen färben gesucht und auch was gefunden doch leider nicht das was ich suche:
Mein Wunsch wäre dass ich einen bestimmten Bereich markieren kann und diesen dann jede 2. Zeile einfärbt, dabei möchte ich je nach meiner Tabelle die Farbe bestimmen können über eine Auswahl geht das und kann mir das jemand in mein Makro einbauen?
Für eure Hilfe besten Dank
Gruss MaBlu
https://www.herber.de/bbs/user/110890.xlsm

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich Zellen Färben mit Farbwahl
26.01.2017 08:40:49
Matthias
Hallo
Meinst Du so?
Option Explicit
Sub BereichZellenFaerben()
Dim Bereich As String, lo As String, ru As String
Dim zo As Long, zu As Long, i As Long
Dim sl As Integer, sr As Integer
Dim Farbe1, Farbe2
On Error GoTo Fehler
Farbe1 = InputBox("Bitte Farbindex eingeben", "Farbindex 1", 15)
Farbe2 = InputBox("Bitte Farbindex eingeben", "Farbindex 2", 16)
Bereich = Selection.Address(False, False)
lo = Left(Bereich, InStr(Bereich, ":") - 1)             'links oben
ru = Right(Bereich, Len(Bereich) - InStr(Bereich, ":")) 'rechts unten
zo = Range(lo).Row                                      'Zeile oben
zu = Range(ru).Row                                      'Zeile unten
sl = Range(lo).Column                                   'Spalte links
sr = Range(ru).Column                                   'Spalte rechts
For i = zo To zu Step 2
Range(Cells(i, sl), Cells(i, sr)).Interior.ColorIndex = Farbe1
Range(Cells(i + 1, sl), Cells(i + 1, sr)).Interior.ColorIndex = Farbe2
Next i
Exit Sub
Fehler:
MsgBox "Es ist ein Fehler aufgetreten" & vbLf & "Versuchen Sie bitte einen anderen Farbindex" _
b>
End Sub
Gruß Matthias
Anzeige
AW: Bereich Zellen Färben mit Farbwahl
26.01.2017 23:40:15
MaBlu
Hallo Matthias
fast so schön wäre wenn man die farbtabelle sehen würde wenn man auswählen muss!
Aber danke schon mal für den Vorschlag.
Gruss MaBlu
Färben geht auch per Dialog ...
27.01.2017 14:50:21
Matthias
Hallo
Option Explicit
Sub BereichZellenFaerben()
Dim Bereich As String, lo As String, ru As String
Dim zo As Long, zu As Long, i As Long
Dim sl As Integer, sr As Integer
Dim Farbe1, Farbe2
On Error GoTo Fehler
' WICHTIG !                                                  '
' Bereich immer von oben links nach unten rechts markieren ! '
Application.Dialogs(xlDialogEditColor).Show 1
ActiveCell.Interior.ColorIndex = 1
Farbe1 = ActiveCell.Interior.ColorIndex
Application.Dialogs(xlDialogEditColor).Show 2
ActiveCell.Offset(1, 0).Interior.ColorIndex = 2
Farbe2 = ActiveCell.Offset(1, 0).Interior.ColorIndex
Bereich = Selection.Address(False, False)
lo = Left(Bereich, InStr(Bereich, ":") - 1)             'links oben
ru = Right(Bereich, Len(Bereich) - InStr(Bereich, ":")) 'rechts unten
zo = Range(lo).Row                                      'Zeile oben
zu = Range(ru).Row                                      'Zeile unten
sl = Range(lo).Column                                   'Spalte links
sr = Range(ru).Column                                   'Spalte rechts
For i = zo To zu Step 2
Range(Cells(i, sl), Cells(i, sr)).Interior.ColorIndex = Farbe1
Range(Cells(i + 1, sl), Cells(i + 1, sr)).Interior.ColorIndex = Farbe2
Next i
Exit Sub
Fehler:
MsgBox "Es ist ein Fehler aufgetreten" & vbLf & "Versuchen Sie bitte einen anderen Farbindex"
End Sub
Gruß Matthias
Anzeige
hier noch eine kleine Änderung ...
27.01.2017 15:05:23
Matthias
Hallo
Besser so ...
Option Explicit
Sub BereichZellenFaerben()
Dim Bereich As String, lo As String, ru As String
Dim zo As Long, zu As Long, i As Long
Dim sl As Integer, sr As Integer
Dim Farbe1, Farbe2
On Error GoTo Fehler
' WICHTIG !                                                  '
' Bereich immer von oben links nach unten rechts markieren ! '
If Selection.Rows.Count 
Application.Dialogs(xlDialogEditColor).Show 1
ActiveCell.Interior.ColorIndex = 1
Farbe1 = ActiveCell.Interior.ColorIndex
Application.Dialogs(xlDialogEditColor).Show 2
ActiveCell.Offset(1, 0).Interior.ColorIndex = 2
Farbe2 = ActiveCell.Offset(1, 0).Interior.ColorIndex
Bereich = Selection.Address(False, False)
lo = Left(Bereich, InStr(Bereich, ":") - 1)             'links oben
ru = Right(Bereich, Len(Bereich) - InStr(Bereich, ":")) 'rechts unten
zo = Range(lo).Row                                      'Zeile oben
zu = Range(ru).Row                                      'Zeile unten
sl = Range(lo).Column                                   'Spalte links
sr = Range(ru).Column                                   'Spalte rechts
For i = zo To zu Step 2
Range(Cells(i, sl), Cells(i, sr)).Interior.ColorIndex = Farbe1
Range(Cells(i + 1, sl), Cells(i + 1, sr)).Interior.ColorIndex = Farbe2
Next i
Exit Sub
Fehler:
MsgBox "Es ist ein Fehler aufgetreten" & vbLf & "Versuchen Sie bitte einen anderen Farbindex"
End Sub
Gruß Matthias
Anzeige
AW: hier noch eine kleine Änderung ...
27.01.2017 20:39:14
MaBlu
Hallo Matthias
ja genau das habe ich gesucht besten Dank!
Wünsche ein schönes Wochenende
Gruss MaBlu
Danke für Deine Rückmeldung ... owT
27.01.2017 21:07:41
Matthias

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige