Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Excel refuse de mettre du rouge

Excel refuse de mettre du rouge

10 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Francois L
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

Avatar
Jp Pradier
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
Avatar
garnote
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" a écrit dans le message de news: eg$
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




Avatar
garnote
Merci J.P.
Merci François

A+
Serge
Avatar
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
Avatar
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)))

Avatar
garnote
;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" a écrit dans le message de news: %
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)))





Avatar
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)))
Avatar
garnote
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" a écrit dans le message de news: ezs%
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



Avatar
garnote
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" a écrit dans le message de news: %
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)))