Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

alain.raphael

XLDnaute Occasionnel
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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 )
 

Pièces jointes

  • Exemple.xlsm
    516.1 KB · Affichages: 1

alain.raphael

XLDnaute Occasionnel
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...
 

Pièces jointes

  • Exemple.xlsm
    566.8 KB · Affichages: 0

Gégé-45550

XLDnaute Accro
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,
 

Pièces jointes

  • Exemple_new.xlsm
    575.3 KB · Affichages: 2

alain.raphael

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…