Hallo Harald,
du kannst dir ja den Vorgang des Füllens mit dem Makrorecorder aufzeichnen. Damit hattu schon ein Gespür für die Syntax!
Für Tabellen-Christbaumschmuck mit VBA Code benutze ich eigene, vorbereitete Funktionen - hier als Beispiel
Sub Testit()
'hier die Rechteckfüllung
Dim dblRa As Double 'Füllgradient 0-1
Dim dblFg As Double 'Vordergrund
Dim dblBg As Double 'Hintergrund
Dim dblP0 As Double 'Füllung ab/am Gradient
Dim dblP1 As Double 'Füllung bis/am Gradient
Dim rngZelle As Range 'Zielbereich
'Versuch 1 mit den Standardwerten und definierten Variablen
Set rngZelle = ActiveSheet.Range("H14")
dblRa = 0.5 '
dblFg = RGB(255, 0, 0) 'rot
dblBg = RGB(255, 255, 255) 'weiß
dblP0 = 0 'Postion am Gradient 0 bis < P1
dblP1 = 1 'Postion am Gradient > P1 bis <1
Call MkRectangleFill(rngZelle, dblRa, dblFg, dblBg, dblP0, dblP1)
MsgBox "Guck"
'Versuch 2 mit freien Werten, direkt
Call MkRectangleFill([E5:F6], 0.3, RGB(200, 150, 200), RGB(245, 250, 100), 0.1, 0.9)
MsgBox "Guck"
'Versuch 3 mit freien Werten, Bereich verbinden
Call MkRectangleFill([B2:C10], 0.5, 143482, 16247773, 0, 1, True)
End Sub
Private Function MkRectangleFill(Zelle As Range, Ra, Fg, Bg, P0, P1, Optional Mrg As Boolean)
Zelle.MergeCells = Mrg
With Zelle
With .Interior
.Pattern = xlPatternRectangularGradient
With .Gradient
.RectangleLeft = Ra
.RectangleRight = Ra
.RectangleTop = Ra
.RectangleBottom = Ra
.ColorStops.Clear
With .ColorStops.Add(P0)
.Color = Fg
End With
With .ColorStops.Add(P1)
.Color = Bg
End With
End With
End With
End With
End Function
Alles klar?
LG frau
|