Excel refuse de mettre du rouge

Le
garnote
Bonsoir,

Voici deux macros ayant la même structure.
Elles permettent d'obtenir des formes polygonales.
Dans les deux macros, je demande que la forme
obtenue soit rouge. Pour la macro SEPT, ça va,
mais la macro HUIT me renvoie une forme sans couleur !
Curieux, non ?
Que se passe-t-il donc ?

Serge

Sub SEPT()
Dim T(1 To 15, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim poly As Object
x = Array(24, 24, 36, 36, 60, 60, 84, 84, 96, 96, 120, 120, 132, 132, 24)
y = Array(24, 60, 60, 120, 120, 72, 72, 96, 96, 48, 48, 132, 132, 24, 24)
For i = 1 To 15
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
Set poly = F.Shapes.AddPolyline(T)
poly.Line.Visible = msoFalse
poly.Fill.ForeColor.SchemeColor = 10
End Sub

Sub HUIT()
Dim T(1 To 16, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim poly As Object
x = Array(156, 156, 168, 168, 180, 180, 204, 204, 228, 228, 240, 240, 252, 252, 132, 132)
y = Array(72, 36, 36, 108, 108, 60, 60, 84, 84, 120, 120, 72, 72, 24, 24, 72)
For i = 1 To 16
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
Set poly = F.Shapes.AddPolyline(T)
poly.Line.Visible = msoFalse
poly.Fill.ForeColor.SchemeColor = 10
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Francois L
Le #4441981
Bonsoir,

Voici deux macros ayant la même structure.
Elles permettent d'obtenir des formes polygonales.
Dans les deux macros, je demande que la forme
obtenue soit rouge. Pour la macro SEPT, ça va,
mais la macro HUIT me renvoie une forme sans couleur !
Curieux, non ?
Que se passe-t-il donc ?

Bonsoir,


Boucler la forme de la macro HUIT :

Sub HUIT()
Dim T(1 To 17, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim poly As Object
x = Array(156, 156, 168, 168, 180, 180, 204, 204, 228, 228, 240,
240, 252, 252, 132, 132, 156)
y = Array(72, 36, 36, 108, 108, 60, 60, 84, 84, 120, 120, 72, 72,
24, 24, 72, 72)
For i = 1 To 17
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
Set poly = F.Shapes.AddPolyline(T)
poly.Line.Visible = msoFalse
poly.Fill.ForeColor.SchemeColor = 10
End Sub

--
François L

Jp Pradier
Le #4441961
Bonjour Serge

Dans ta deuxieme macro, tu ne reviens pas à ton point de départ. La figure
n'est pas fermée et donc ne peut pas se colorer.

j-p
garnote
Le #4441921
OK, j'ai trouvé. Je n'avais pas fermé la forme.
J'ai ajouté 156 à la fin de x = Array (....),
72 à la fin de y = Array (....) et j'ai remplacé
16 par 17.

Bonne soirée à tous et toutes.

Serge


"garnote"
Bonsoir,

Voici deux macros ayant la même structure.
Elles permettent d'obtenir des formes polygonales.
Dans les deux macros, je demande que la forme
obtenue soit rouge. Pour la macro SEPT, ça va,
mais la macro HUIT me renvoie une forme sans couleur !
Curieux, non ?
Que se passe-t-il donc ?

Serge

Sub SEPT()
Dim T(1 To 15, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim poly As Object
x = Array(24, 24, 36, 36, 60, 60, 84, 84, 96, 96, 120, 120, 132, 132, 24)
y = Array(24, 60, 60, 120, 120, 72, 72, 96, 96, 48, 48, 132, 132, 24, 24)
For i = 1 To 15
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
Set poly = F.Shapes.AddPolyline(T)
poly.Line.Visible = msoFalse
poly.Fill.ForeColor.SchemeColor = 10
End Sub

Sub HUIT()
Dim T(1 To 16, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim poly As Object
x = Array(156, 156, 168, 168, 180, 180, 204, 204, 228, 228, 240, 240, 252, 252, 132, 132)
y = Array(72, 36, 36, 108, 108, 60, 60, 84, 84, 120, 120, 72, 72, 24, 24, 72)
For i = 1 To 16
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
Set poly = F.Shapes.AddPolyline(T)
poly.Line.Visible = msoFalse
poly.Fill.ForeColor.SchemeColor = 10
End Sub




garnote
Le #4441901
Merci J.P.
Merci François

A+
Serge
Ninbihan
Le #4441721
Bonsoir Garnote

Le polygone produit par la macro huit n'est pas fermé(j'ai fait l'essai sans
couleur mais avec poly.Line.Visible = msoTrue), donc pas de couleur de
remplissage...
Celui de la 7 l'est.

Bonne soirée

Ninbihan
Modeste
Le #4441701
Bonsour® garnote avec ferveur ;o))) vous nous disiez :

Pour la macro SEPT, ça va,
mais la macro HUIT me renvoie une forme sans couleur !
Curieux, non ?
Que se passe-t-il donc ?


;o))) essaie plutot la macro QUATRE :!!!!

Sub QUATRE_Nada()
Dim T(1 To 26, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim DA As Object, NA As Object, CA As Object
x = Array(254, 273, 288, 277, 300, 301, 320, 314, 323, 292, 306, 258, 259,
249, 253, 207, 231, 190, 202, 192, 210, 205, 240, 224, 240, 254)
y = Array(11, 40, 30, 87, 66, 76, 74, 88, 90, 110, 126, 112, 155, 155, 112,
126, 110, 90, 88, 74, 76, 66, 87, 30, 40, 11)
For i = 1 To 26
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
'-------------
Set DA = F.Shapes.AddShape(msoShapeRectangle, 115#, 12#, 58#, 168#)
DA.Line.Visible = msoFalse
DA.Fill.ForeColor.SchemeColor = 10
'-----------------------
Set NA = F.Shapes.AddPolyline(T)
NA.Line.Visible = msoFalse
NA.Fill.ForeColor.SchemeColor = 10
'------------------
Set CA = F.Shapes.AddShape(msoShapeRectangle, 330#, 12#, 58#, 168#)
CA.Line.Visible = msoFalse
CA.Fill.ForeColor.SchemeColor = 10
End Sub

--
--
@+
;o)))

garnote
Le #4441491
;o)))

Et pourquoi pas :

Sub UE()
Dim Etoile As Object
Dim r As Double
Dim i As Integer
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 216, 96, 216, 144)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 48
.ZOrder msoSendToBack
End With
Set Etoile = ActiveSheet.Shapes.AddShape(msoShape5pointStar, 0, 0, 12, 12)
Etoile.Line.Visible = msoFalse
Etoile.Fill.ForeColor.SchemeColor = 13
r = Etoile.Width / 2
For i = 0 To 11
With Etoile.Duplicate
.Left = 270 + 54 + 54 * Cos(WorksheetFunction.Radians(30 * i)) - r
.Top = 114.75 + 54 - 54 * Sin(WorksheetFunction.Radians(30 * i)) - r
End With
Next i
Etoile.Delete
End Sub

Dément tes phases lunaires !

Serge


"Modeste"
Bonsour® garnote avec ferveur ;o))) vous nous disiez :

Pour la macro SEPT, ça va,
mais la macro HUIT me renvoie une forme sans couleur !
Curieux, non ?
Que se passe-t-il donc ?


;o))) essaie plutot la macro QUATRE :!!!!

Sub QUATRE_Nada()
Dim T(1 To 26, 1 To 2) As Single
Dim F As Worksheet
Dim x, y
Dim i As Integer
Dim DA As Object, NA As Object, CA As Object
x = Array(254, 273, 288, 277, 300, 301, 320, 314, 323, 292, 306, 258, 259, 249, 253, 207, 231, 190, 202, 192, 210, 205, 240,
224, 240, 254)
y = Array(11, 40, 30, 87, 66, 76, 74, 88, 90, 110, 126, 112, 155, 155, 112, 126, 110, 90, 88, 74, 76, 66, 87, 30, 40, 11)
For i = 1 To 26
T(i, 1) = x(i - 1)
T(i, 2) = y(i - 1)
Next i
Set F = ActiveSheet
'-------------
Set DA = F.Shapes.AddShape(msoShapeRectangle, 115#, 12#, 58#, 168#)
DA.Line.Visible = msoFalse
DA.Fill.ForeColor.SchemeColor = 10
'-----------------------
Set NA = F.Shapes.AddPolyline(T)
NA.Line.Visible = msoFalse
NA.Fill.ForeColor.SchemeColor = 10
'------------------
Set CA = F.Shapes.AddShape(msoShapeRectangle, 330#, 12#, 58#, 168#)
CA.Line.Visible = msoFalse
CA.Fill.ForeColor.SchemeColor = 10
End Sub

--
--
@+
;o)))





Modeste
Le #4441431
Bonsour® garnote avec ferveur ;o))) vous nous disiez :

du vent !!!!

Sub UE()
Dim Etoile As Object
Dim r As Double
Dim i As Integer
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet.Shapes.AddShape(msoShapeDoubleWave, 216, 80, 216, 180)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 48
.ZOrder msoSendToBack
End With
Set Etoile = ActiveSheet.Shapes.AddShape(msoShape5pointStar, 0, 0, 12, 12)
Etoile.Line.Visible = msoFalse
Etoile.Fill.ForeColor.SchemeColor = 13
r = Etoile.Width / 2
For i = 0 To 11
With Etoile.Duplicate
.Left = 270 + 54 + 54 * Cos(WorksheetFunction.Radians(30 * i)) - r
.Top = 114.75 + 54 - 54 * Sin(WorksheetFunction.Radians(30 * i)) - r
End With
Next i
Etoile.Delete
ActiveSheet.Shapes("AutoShape 1").Select
'
For i = 0 To 3600 Step 2
xx = 0.03 * Sin(Application.Radians(i))
Selection.ShapeRange.Adjustments.Item(1) = Abs(xx)
Selection.ShapeRange.Adjustments.Item(2) = 0.5 + xx / 5
DoEvents
Next
End Sub
--
--
@+
;o)))
garnote
Le #4441421
Merci Ninbihan

Mais curieusement, même s'il n'était pas fermé, je pouvais
le "faire rougir" en le sélectionnant et en cliquant le menu
Format / Forme automatique...
Onglet "Couleurs et traits" : Remplissage : Rouge.

Serge


"Ninbihan"
Bonsoir Garnote

Le polygone produit par la macro huit n'est pas fermé(j'ai fait l'essai sans couleur mais avec poly.Line.Visible = msoTrue), donc
pas de couleur de remplissage...
Celui de la 7 l'est.

Bonne soirée

Ninbihan



garnote
Le #4441391
Ah ben ça alors ! Je suis bouche la bée ;-)

Mais :
Et le sifflement du vent ?
Et les étoiles qui bougent même pas!

;o)))

Serge


"Modeste"
Bonsour® garnote avec ferveur ;o))) vous nous disiez :

du vent !!!!

Sub UE()
Dim Etoile As Object
Dim r As Double
Dim i As Integer
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet.Shapes.AddShape(msoShapeDoubleWave, 216, 80, 216, 180)
.Line.Visible = msoFalse
.Fill.ForeColor.SchemeColor = 48
.ZOrder msoSendToBack
End With
Set Etoile = ActiveSheet.Shapes.AddShape(msoShape5pointStar, 0, 0, 12, 12)
Etoile.Line.Visible = msoFalse
Etoile.Fill.ForeColor.SchemeColor = 13
r = Etoile.Width / 2
For i = 0 To 11
With Etoile.Duplicate
.Left = 270 + 54 + 54 * Cos(WorksheetFunction.Radians(30 * i)) - r
.Top = 114.75 + 54 - 54 * Sin(WorksheetFunction.Radians(30 * i)) - r
End With
Next i
Etoile.Delete
ActiveSheet.Shapes("AutoShape 1").Select
'
For i = 0 To 3600 Step 2
xx = 0.03 * Sin(Application.Radians(i))
Selection.ShapeRange.Adjustments.Item(1) = Abs(xx)
Selection.ShapeRange.Adjustments.Item(2) = 0.5 + xx / 5
DoEvents
Next
End Sub
--
--
@+
;o)))




Publicité
Poster une réponse
Anonyme