Marquer des cellules déterminées

Re : Marquer des cellules déterminées

Salut,

Une petite macro à appeler après avoir selectionné les cellules à cocher.

Sub CoinBleu()
' Macro crée le 28/01/2008 par Celeborn !
Taille = 5 ' Tu peux changer la taille du triangle ici
For Each Cel In Selection.Cells
X = Cel.Left
Y = Cel.Top
Nom = "NomTriangleBleu_" & Cel.Row & "_" & Cel.Column
On Error GoTo NexistePas
' Désolé pour la gestion, mais pas le temps de trouver plus élégant. ;-)
A = ActiveSheet.Shapes(Nom)
GoTo Existe
NexistePas:
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X, Y)
.AddNodes msoSegmentLine, msoEditingAuto, X, Y + Taille
.AddNodes msoSegmentLine, msoEditingAuto, X + Taille, Y
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
.ConvertToShape.Name = Nom
End With
With ActiveSheet.Shapes(Nom)
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 12
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
Existe:
On Error GoTo 0
Next Cel
End Sub

Re : Marquer des cellules déterminées

Merci Celeborn61,

Ça marche presque.
Si je sélectionne qu'une seule cellule, OK. Mais si j'en séctionne plusieurs... message d'erreur me disant que le nom spécifié n'a pas été trouvé (je traduis de l'espagnol vers le français...).

Re : Marquer des cellules déterminées

Petit bidouillage qui fait que ça marche.

Sub CoinBleu()
' Une petite macro à appeler après avoir selectionné les cellules à cocher.
' Macro crée le 28/01/2008 par Celeborn !

Dim Cel As Range, taille%, nom$

taille% = 7 ' Tu peux changer la taille du triangle ici

'les cellules concernées
Range("E7" & ":" & "E10").Select

For Each Cel In Range("E7" & ":" & "E10")
X = Cel.Left
Y = Cel.Top
nom$ = "NomTriangleBleu_" & Cel.Row & "_" & Cel.Column

With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, X, Y)
.AddNodes msoSegmentLine, msoEditingAuto, X, Y + taille%
.AddNodes msoSegmentLine, msoEditingAuto, X + taille%, Y
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
.ConvertToShape.Name = nom$
End With

With ActiveSheet.Shapes(nom$)
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 12
.Line.BackColor.RGB = RGB(255, 255, 255)
End With

On Error GoTo 0 'KEZAKO ????
Next Cel
End Sub

Re : Marquer des cellules déterminées

Salut,

Désolé, mais je ne comprend pas qu'il y est une erreur générée alors que j'avais mit une redirection d'erreur.
D'ailleur, si quelqu'un peu me donner des réponses ?!.

La gestion d'erreur que j'avais installée était là pour éviter d'essayer de dessinner plus d'un triangle par cellule.(Conflit de nom)

Enléve juste les On error goto pour pouvoir faire une selection multiple.

Avec tes modifications, tu mets une selection de cellules en place qui remplace celle que tu aurais pû selectionner avant l'appel de la macro.

Nota: Le On error goto 0 est la fin de la gestion des erreurs.