Nommer suite de shape

[Noopy123]

Bonjour,

J'ai une suite de shape rectangle qui se créé selon le code suivant :

x = ActiveCell.Row               ' définit la ligne de la cellule active
y = ActiveCell.Column           ' définit la colonne de la cellule active
For L = x To x + 5              ' 8 est le nombre de rectangles en X
    For C = y To y + 5          ' 5 est le nombre de rectangles en Y
        With Cells(L, C)
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
            Selection.ShapeRange.ShapeStyle = msoShapeStylePreset1
              
             End With
        
    Next C
Next L

J’aimerais pourvoir nommer les rectangles créés ,via ce code, avec la cellules dans lequel ils paraissent (sachant que la cellule est aléatoire en fonction de la cellule sélectionnée , ... Mais impossible de trouver la solution
Sinon a Default de leur donner les nom 1,2,3,4....

Merci par avance pour votre aide

 

[Staple1600]

Bonjour

Noopy123
Je suppose que c'est la suite e ton précédent fil...

 

[Noopy123]

Bonjour
Exactement ^^.
J’avance petit à petit mais je me suis lancée dans quelque chose qui dépasse largement mais faible compétence (mais ça a le mérite de les amélioré ^^).

 

[Staple1600]

Re

Dans ce cas, il suffisait d'adapter une de mes propositions

Sub Encadrez_Et_Nommez_Moi()
Dim c, shp
If TypeName(Selection) = "Range" Then
With ActiveSheet
    For Each c In Selection
    Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
    shp.Line.ForeColor.RGB = RGB(192, 0, 0)
    shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    shp.Name = "Rect_" & c.Address(0, 0)
    Next
End With
End If
End Sub

NB: Si tu joignais un fichier exemple, et plus d'explications concrètes, on avancerait plus vite

 

[Staple1600]

Re

•>Noopy123 (AKA Leeya)
Juste pour ta gouverne...
L'usage quand on multiposte sa question, c'est de le signaler simplement
(ou mieux avec un lien)

Aligner rectangle

J'aimerais aligner 5 rectangles dans 6 cellules (la largeur totale des 5 rectangles = largeur des 6 cellules). Mais mes 5 rectangles se mettent directement d...

forum.excel-pratique.com

Et si tu veux connaitre, l'origine de cet usage, voir ici:

Multipostage — Wikipédia

fr.wikipedia.org

 

[Noopy123]

Desole je ne pensais pas faire quelque chose de mal :/.

voici le fichier

 

[Noopy123]

Pour information, Les cellules du document seront verrouillées par l'utilisateur, seul les shapes seront clicable et la gestion de la creation des formes ne se fera que par l'utilisation de l'userform

 

[Staple1600]

Re

•>Noopy123
1) Où ai-je écris que c'était mal?
Tu as été voir le lien de Wikipédia?

2) Tu as testé le code proposé dans le message#4?
Apparemment, non puisque pas de retour&commentaire de ta part...

 

[Noopy123]

Je suis en train de le tester. J'essaie de l'adapter afin que le code me génère une forme de 6 rectangle sur 6 rectangle pour ne pas embêter si j'arrive sur un mal entendu à le faire toute seule ^^

 

[Staple1600]

Re

•>Noopy123
Pas de réponse à la question 1) ?


Pour le reste: 6x6=36

Sub Grille_Six_par_Six()
Dim c, Grille As Range, shp As Shape
If TypeName(Selection) = "Range" Then
Set Grille = Selection.Item(1).Resize(6, 6)
Grille.RowHeight = 50: Grille.ColumnWidth = 4.86
With ActiveSheet
    For Each c In Grille
    Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
    shp.Line.ForeColor.RGB = RGB(192, 0, 0)
    shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    shp.Name = "Rect_" & c.Address(0, 0)
    Next
End With
End If
End Sub

 

[Noopy123]

Non rien à repondre à 1), mea culpa ^^

Le code est top mais il ne correspond qu'à un seul cas de figure ( ce dessous l'userform utilisé avec les differentes formes crées ( des fois c'est 6*6, d'autre c'est 5*2, ...)

Le but est de faire apparaître dans l’ordre voulu par l'utilisateur les formes sélectionnée via optionbutton. C'est pour cela que je voulais rebondir sur le code cité dans le premier post car avec celui ci j'arrive à creer les formes presentées. Maintenant il ne me reste plus qu'a reussir à leur donner un nom ^^

 

[Noopy123]

En fait le combo parfait serait de réussir à utiliser le code de base et lui ajouter ton code afin d'avoir les bons noms sur les bonnes formes car les deux marchent au top mais indépendamment ^^

 

[Noopy123]

Je suis en train de m'approprier ton code, par contre j'ai une petite question. J'aimerais redimensionner mes colonnes une fois les shapes créées. J'ai ajouté un placement xlFreeFloating afin que mes shapes ne bougent pas quand je redimensionne mes colonnes mais ca ne marche pas
Voila le code que j'ai voulu faire :

If TypeName(Selection) = "Range" Then
Set Grille = Selection.Item(1).Resize(2, 5)
Grille.RowHeight = 50: Grille.ColumnWidth = 6
With ActiveSheet
    For Each c In Grille
    Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
    shp.Line.ForeColor.RGB = RGB(192, 0, 0)
    shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    shp.Name = "Rect_" & c.Address(0, 0)
    shp.Placement = xlFreeFloating
Set Grille = Selection.Item(1).Resize(2, 5)
Grille.RowHeight = 50: Grille.ColumnWidth = 4.91
    Next
End With
End If

 

[Noopy123]

Solution trouvée !! (petite victoire personelle ^^).
J'ai remis mon code contenant la nouvelle taille de colonne sous le End If et le ça marche !

 

[Staple1600]

Re

Très bien.
Dans ce cas, publie ici ta solution (pour le bénéfice de tous)