RGB-Farbe benutzen ?
04.03.2007 13:22:00
Selma
ich möchte in bereits vorhandenen Code (siehe unten) die Color.Index Farben 45, 15, 35 in
RGB-Farben ändern, ohne die Farbtabelle zu verändern. Geht das, wenn ja, was muss ich ändern ?
Für ColorIndex 45 die RGB-Farben: 255, 102, 0
Für ColorIndex 15 die RGB-Farben: 153, 255, 153
Für ColorIndex 35 die RGB-Farben: 248, 255, 227
Die Beispieldatei (mit ein Screenshot, wie es hinterher sein soll): https://www.herber.de/bbs/user/40836.xls
Vielen Dank im Voraus...
Liebe Grüße
SELMA
Sub Formatierung()
'Systematische Formatierung von Zellen in gewählten Dateien
Dim wb As Workbook, wks As Worksheet, Zeile As Long, ZeileL As Long, Spalte As Integer
Dim strWb, j As Integer, i As Integer
Do
'Arbeitsmappe(n) auswählen, die formatiert werden sollen, _
Mehrfachauswahl im Dialog ist möglich
strWb = Application.GetOpenFilename(Filefilter:="Excel (*.xls), *.xls", _
Title:="Bitte Datei(en) für Formatierung auswählen, Abbrechen beendet das Makro", _
MultiSelect:=True)
If Not IsArray(strWb) Then Exit
Sub 'Abbrechen wurde im Dialog gewählt
'Gewälte Dateien abarbeiten
For j = LBound(strWb) To UBound(strWb)
Set wb = Workbooks.Open(Filename:=strWb(j))
Application.ScreenUpdating = False
'Alle Blätter der Arbeitsmappe formatieren
For i = 1 To wb.Worksheets.Count 'to auf 1 setzen wenn immer nur das 1. Blatt formatiert werden _
soll
Set wks = wb.Worksheets(i)
With wks
Zeile = 1
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row 'Letzte Zeile mit Daten
Do
'Zeile mit "$TYP:" suchen
Do Until .Cells(Zeile, 1).Value = "$TYP:"
If Zeile > ZeileL Then GoTo NextBlatt
Zeile = Zeile + 1
Loop
'Typ-Zellen formatieren
.Range(.Cells(Zeile, 1), .Cells(Zeile, 2)).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, 2)), 45, xlContinuous, xlHairline)
'Überschrift-Zeile formatieren
Zeile = Zeile + 1
Spalte = .Cells(Zeile, .Columns.Count).End(xlToLeft).Column 'Letzte Spalte in Überschriftzeile
.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)), 15, xlContinuous, xlHairline)
'Daten-Zeilen formatieren
Do Until IsEmpty(.Cells(Zeile + 1, 1))
If Zeile > ZeileL Then GoTo NextBlatt
Zeile = Zeile + 1
.Cells(Zeile, 1).Font.Bold = True
Call RahmenFarbe(.Range(.Cells(Zeile, 1), .Cells(Zeile, Spalte)), 35, xlContinuous, xlHairline)
Loop
Loop
End With
NextBlatt:
Next i
Application.ScreenUpdating = True
'Datei speichern und schließen
wb.Save
wb.Close
Next j
Loop
End Sub
Sub RahmenFarbe(Bereich As Range, Farbe, LinieStil, LinieBreite)
'Farbe und Linien des Zellbereichs formatieren
With Bereich
.Interior.colorindex = Farbe
.BorderAround LineStyle:=LinieStil, Weight:=LinieBreite
With .Borders(xlInsideVertical)
.LineStyle = LinieStil
.Weight = LinieBreite
End With
End With
End Sub