Office: Bestimmte Schriftfarbe für bestimmte Zellen (VBA)

Hallo zusammen

Ich habe eine kleine Aufgabe in Excel 2000 bekommen. Ich soll bestimmte Zellen in einer bestimmten Stift-Farbe darstellen.
Dies sollte mittels VBA passieren, damit die Farben nicht geändert werden können.
Im Anhang ist die Datei zu finden.

- Die Zellen (Abmessung) Bereich D4-G8 sollen die Stiftfarbe rot bekommen.
- Die Zellen (Bau) Bereich D9-G15 sollen die Stiftfarbe blau bekommen.
- Die Zellen (Klima ...) Bereich D16-G22 sollen die Stiftfarbe hellblau bekommen.
- Die Zellen (Elektro ...) Bereich D23-G36 sollen die Stiftfarbe orange bekommen.
- Die Zellen (Energie ...) Bereich D37-G53 sollen die Stiftfarbe grün bekommen.
- Die Zellen (Mobiliar ...) Bereich D54-G63 sollen die Stiftfarbe violett bekommen.
- Die Zellen (Sicherheit...) Bereich D64-G72 sollen die Stiftfarbe pink bekommen.

Wenn mir jemand helfen könnte wäre sehr dankbar.
Gruss eco

 

mache die Farbe doch einmal von Hand. Das ist doch kein Aufwand. Falls die Farbe nicht verändert werden soll schütze die Tabelle, das mußt Du auch bei einer VBA Lösung.

Gruß Hajo

 

Es ist so.
Die Tabellen gehen auch an andere Unternehmer und da geht das als schief. Die Farbe ist dann schon mal schwarz. Zudem habe ich mehrere Blätter, diese müsste ich alle manuell kontrollieren. Bei mehreren hunderten Blättern dauert dies ewig. Mit VBA könnte ich die entsprechenden Zeilen immer in die jeweiligen Dokumente kopieren und müsste micht manuell jedes Blatt durchsehen.

gruss eco

 

Du könntest folgende Routine in ein Extra-Modul packen:

Code:

Option Explicit

Public Sub Zellen_einfaerben()

    Const sht_einfaerben = "3 Büro (4WP) 8. OG"

    Dim s1 As Worksheet
    Dim n As Long
    Dim r As String
    Dim c As Long

    Set s1 = Worksheets(sht_einfaerben)

    For n = 1 To 7
        Select Case n
            Case 1: 'rot
                r = "d4:g8"
                c = RGB(255, 0, 0)
            Case 2: 'blau
                r = "d9:g15"
                c = RGB(0, 0, 255)
            Case 3: 'hellblau
                r = "d16:g22"
                c = RGB(128, 128, 255)
            Case 4: 'orange
                r = "d23:g36"
                c = RGB(192, 192, 0)
            Case 5: 'grün
                r = "d37:g53"
                c = RGB(0, 255, 0)
            Case 6: 'violett
                r = "d54:g63"
                c = RGB(128, 0, 128)
            Case 7:
                r = "d64:g72"
                c = RGB(255, 128, 128)
        End Select
        s1.Range(r).Interior.Color = c
    Next n

End Sub

(Ersetze bitte in der endgültigen Form ".interior" durch ".font". Ich hab erstmal den Hintergrund eingefärbt, weil man die Farben dann besser erkennen kann...)

Die Frage ist nur, wann jeweils das Einfärben aufgerufen werden soll...

Ein Ansatz wäre das "Change" Ereignis des Blattes. Also im VBA-Source des Blatts dann:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Zellen_einfaerben

End Sub

Gruß, Michael

 

Danke für den Code.

Leider funktioniert der bei mir irgendwie nicht.
Sieh Datei Anhang.

Die Farbe der Schrift sollte sofort sichtbar sein.

gruss eco

 

Doch, schon, ist aber ein kleiner Fehler bei der Übertragung drin gewesen. (Es sollte nicht alles in das Blatt-Modul, sondern ein Teil in ein globales Modul.)

Außerdem schrieb ich ja, das die Frage ja auch ist, _wann_ eingefärbt werden soll. Ich hab jetzt zusätzlich auch noch das Einfärben beim Öffnen der Mappe mit eingebaut.

Gruß, Michael

 

Super es funktioniert perfekt.

Besten Dank
eco

 

Hallo

Ich hab noch ein kleines Problem gefunden, und zwar wenn ich mehrere Tabellenblätter im Dokument habe und jedes natürlich unterschiedlich benannt ist, wird ein Laufzeitfehler 9 ausgegeben.
Kann man dem Modul sagen das es alle Blätter im Dokument so färben soll ohne ein Blatt exakt zu benennen:
(Const sht_einfaerben = "3 Büro (4WP) 8. OG").

Gruss eco

 

Ich hatte mir schon fast gedacht, daß die Frage kommen würde... ;-)

Es gibt zwei Möglichkeiten:

1) Es werden wirklich brutal und ohne Rücksicht auf Verluste alle Blätter der Mappe durchgeackert.

2) In einer Schleife, die um die jetzige herum gestrickt wird, werden die einzelnen Blätter durchlaufen, auf die es zutrifft.

Für 1) ersetze den Code in "Modul1" durch:

Code:

Option Explicit

Public Sub Zellen_einfaerben()

    'Const sht_einfaerben = "3 Büro (4WP) 8. OG"

    Dim s1 As Worksheet
    Dim m As Long
    Dim n As Long
    Dim r As String
    Dim c As Long

    For m = 1 To Worksheets.Count
    Set s1 = Worksheets(m)

    For n = 1 To 7
        Select Case n
            Case 1: 'rot
                r = "d4:g8"
                c = RGB(255, 0, 0)
            Case 2: 'blau
                r = "d9:g15"
                c = RGB(0, 0, 255)
            Case 3: 'hellblau
                r = "d16:g22"
                c = RGB(128, 128, 255)
            Case 4: 'orange
                r = "d23:g36"
                c = RGB(192, 192, 0)
            Case 5: 'grün
                r = "d37:g53"
                c = RGB(0, 255, 0)
            Case 6: 'violett
                r = "d54:g63"
                c = RGB(128, 0, 128)
            Case 7:
                r = "d64:g72"
                c = RGB(255, 128, 128)
        End Select
        s1.Range(r).Interior.Color = c
    Next n

    Next m

End Sub

Gruß, Michael

 

OK jetzt ist es perfekt.

Danke eco