AW: Zeichen auf 4 stellen links/rechts einfärben
22.11.2008 09:58:00
Tino
Hallo,
teste mal diesen Code, Du wirst zur Auswahl von zwei Farben aufgefordert.
Da unter xl2007 nicht alle Farben verwendet werden, kann es sein dass mansche Farben nicht wie ausgewählt angezeigt werden.
Modul Modul1
Option Explicit
Sub Start()
Dim i As Long, iStartRechts As Integer
Dim Farbe1 As Double, Farbe2 As Double
Farbe1 = ColorFromPallet 'Auswahl Farbe 1
Farbe2 = ColorFromPallet 'Auswahl Farbe 2
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
With Cells(i, "B")
If Len(.Value) > 7 Then
iStartRechts = Len(.Value) - 3
.Characters(Start:=1, Length:=4).Font.Color = Farbe1
.Characters(Start:=iStartRechts, Length:=4).Font.Color = Farbe2
End If
End With
Next i
End Sub
Function ColorFromPallet(Optional lOldCol As Double = xlNone) As Double
Dim dSavCol As Double, dNewCol As Double
Dim iRGB_R As Integer, iRGB_G As Integer, iRGB_B As Integer
dSavCol = ActiveWorkbook.Colors(32)
If lOldCol = xlNone Then
ColIx2RGB 13160660, iRGB_R, iRGB_G, iRGB_B
Else
ColIx2RGB lOldCol, iRGB_R, iRGB_G, iRGB_B
End If
If Application.Dialogs(xlDialogEditColor).Show _
(32, iRGB_R, iRGB_G, iRGB_B) Then
ColorFromPallet = ActiveWorkbook.Colors(32)
ActiveWorkbook.Colors(32) = dSavCol
Else
ColorFromPallet = lOldCol
End If
End Function
Sub ColIx2RGB(ByVal lCol As Long, _
iR As Integer, iG As Integer, iB As Integer)
iR = lCol Mod 256: lCol = lCol \ 256
iG = lCol Mod 256: lCol = lCol \ 256
iB = lCol Mod 256
End Sub
Gruß Tino
www.VBA-Excel.de