grünrote Farbskala

Sub Makro1() Dim S As Shape, N As Integer ' Left, Top, Width, Height) For Each S In ActiveSheet.Shapes S.Delete Next S For N = 255 To 1 Step -1 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 256 - N, 100, 1, 20).Select With Selection Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.ForeColor.SchemeColor = RGB(0, 0, 0) Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse End With Next N End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub version() Dim Sh As Shape, N As Integer ActiveSheet.DrawingObjects.Delete For N = 255 To 1 Step -1 Set Sh = ActiveSheet.Shapes.AddShape(1, 256 - N, 100, 1, 20) With Sh .Line.Visible = 0 .Fill.Solid .Fill.Visible = -1 .Fill.ForeColor.RGB = RGB(0, N, 0) .Fill.Transparency = 0 End With Next Set Sh = Nothing End Sub

Hallo K.Rola.
danke dir wie immer :-)
Und dein Rüffel erfolgt zu Recht, iregndwas kommt immer dazwischen, grad kurz vorher wenn ich mal im Editor auf F2 klicken will um zu versuchen mich schlau machen will was das eigentlich da für Objekte sind und was das eigentlich ist so ein Objekt in Vba.
Jetzt habe ich ein anderes Problem was nix mit Vba zu tun hat, ich habe passenderweise Rot/Grün Farbsehschwäche, für mich sieht die entstandene Farbskala so aus, links und rechts mehr oder minder schwarze Stellen, in der Mitte sind links Bereiche die ich als hellgrün bezeichnen würde, rechts davon sowas wie nicht helles Rot.
Deshalb meine Frage noch offen, wie seht ihr das wenn ihr den Code ablaufen lässt.
Mein Plan ist, daß es von links aus gesehen erst dunkelgrün ist dann mit immer weniger Grüntönen helleres Grün wird, dann beginnt der Rotbereich, anfangs mit ganz wenig Rotanteilen bis hin beim Ende bei Knallrot.
Sieht das so aus für euch?
Nachstehend der Code.
Danke ^ Gruß
Reinhard


Sub version()
Dim Sh As Shape, N As Integer
ActiveSheet.DrawingObjects.Delete
For N = 0 To 255
Set Sh = ActiveSheet.Shapes.AddShape(1, N + 1, 100, 1, 20)
With Sh
.Line.Visible = 0
.Fill.Solid
.Fill.Visible = -1
.Fill.ForeColor.RGB = RGB(0, N, 0)
.Fill.Transparency = 0
End With
Next N
For N = 0 To 255
Set Sh = ActiveSheet.Shapes.AddShape(1, 512 - N, 100, 1, 20)
With Sh
.Line.Visible = 0
.Fill.Solid
.Fill.Visible = -1
.Fill.ForeColor.RGB = RGB(N, 0, 0)
.Fill.Transparency = 0
End With
Next N
Set Sh = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread