Bereich Zellen Färben mit Farbwahl

Forumthread: 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

Beliebteste Forumthreads (12 Monate)

Bereich Zellen Färben mit Farbwahl

Forumthread: Bereich Zellen Färben mit Farbwahl

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bereich Zellen Färben mit Farbwahl

Forumthread: Bereich Zellen Färben mit Farbwahl

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread