XL 2016 Macro et rajout d'un chiffre au nom d'un Shape

[alain.raphael]

Bonjour à Tous.

J'ai une macro classique qui permet de colorier des formes à partir d'un TCD.

Je souhaiterai rajouter un chiffre (exemple 2) à la fin du nom de la forme : s.Name.
Pourrait-on imaginer quelquechose comme s.Name & "2"


Macro initiale :

Sub coloriageIS()
Dim couleur As Long, c As Range, ca As Range, p As Long
For Each c In Range("C154:C162").Cells
If c <> "" Then
Set ca = c.Offset(, 2)
p = Application.Match(ca, Range("G110:G120").Cells, 0)
couleur = Range("G110 :G120").Cells(p, 1).Interior.Color
ActiveSheet.Shapes(c).Fill.ForeColor.RGB = couleur
End If
Next c
End Sub

Sub maj()
coloriageIS
End Sub
Sub ListShapes()
i = 2
For Each s In ActiveSheet.Shapes
Cells(i, "q") = s.Name
i = i + 1
Next s
End Sub

 

[Gégé-45550]

Pourrait-on imaginer quelque chose comme s.Name & "2"

Bonsoir,
La réponse est dans la question.
Cordialement,

 

[alain.raphael]

Merci Gégé....

Malheureusement cela ne fonctionne pas. Je joins un exemple.

Exemple nom 1ère carte (Alberes) et nom 2ème carte (Alberes2).

Merci !

 

[sylvanu]

Bonjour Alain, Gégé,
Vos shapes ont été regroupés, donc seul le shape de groupe est traité.
( NB : je n'ai trouvé aucun shape qui s'appelle "Alberes" )
Si vous dissociez vos cartes alors vous avez bien la liste des shapes utilisés.
( que j'ai mis en colonne A pour être entièrement visible )

 

[alain.raphael]

Merci Sylvanu.

J'ai remonté le TCD sur le fichier Exemple.

La 2ème Macro (IS) ne prend pas en compte qu'il doit rajouter un "2" pour pouvoir colorier le SHAPE en question...

 

[Gégé-45550]

Merci Gégé....

Malheureusement cela ne fonctionne pas. Je joins un exemple.

Exemple nom 1ère carte (Alberes) et nom 2ème carte (Alberes2).

Merci !

Bonjour,
ça marche parfaitement ... à condition de lancer la macro correspondante !
Au passage, deux macros portant le même nom dans deux modules différents, ce n'est pas à faire.
J'ai renommé celle du module2 et lancé celle du module3, voir le résultat en PJ.
Cordialement,

 

[alain.raphael]

Gégé.

Cela marche mais seulement sur la 1ère carto (IH).

Lorsque l'on clique sur la macro IS...cette dernière modifie pas la 2nde carto (pour qui elle est destinée avec l'ajout du 2 en fin de nom Shape....) mais la 1ère....qui ne devrait pas être modifiée.

 

[alain.raphael]

Il faut donc que je demande à la macro de prendre la plage C154:C162 et de rajouter "2" au nom de ces cellules...

Sub coloriageIS()
Dim couleur As Long, c As Range, ca As Range, p As Long
For Each c In Range("C154:C162").Cells
If c <> "" Then
Set ca = c.Offset(, 2)
p = Application.Match(ca, Range("G110:G120").Cells, 0)
couleur = Range("G110 :G120").Cells(p, 1).Interior.Color
ActiveSheet.Shapes(c).Fill.ForeColor.RGB = couleur
End If
Next c
End Sub

 

[alain.raphael]

Je ne dois pas être loin avec ceci (module 3 du fichier)

Merci !!

 

[alain.raphael]

Dernier essai ...pour associer une plage de cellules avec un chiffre ?

Sub coloriageIS()
Dim couleur As Long, c As Range, ca As Range, p As Long
Dim cellRange As Range

' Définir la plage de cellules dynamiquement avec "2" ajouté
Set cellRange = Range("C154:C162") & "2"

For Each c In cellRange
If c.Value <> "" Then
' Sélection de la 2ème colonne
Set ca = c.Offset(, 2)
' Rechercher la valeur dans la plage G110:G120
p = Application.Match(ca.Value, Range("G110:G120"), 0)
' Récupérer la couleur correspondante
If Not IsError(p) Then
couleur = Range("E110:E120").Cells(p, 1).Interior.Color
' Appliquer la couleur à la forme correspondante
ActiveSheet.Shapes(c.Value).Fill.ForeColor.RGB = couleur
Else
MsgBox "La valeur n'a pas été trouvée dans la plage G110:G120."
End If
End If
Next c
End Sub