Nommer suite de shape

Noopy123 · 26 Avril 2020

Bonjour,

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

VB:

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 · 26 Avril 2020

Bonjour

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

Noopy123 · 26 Avril 2020

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 · 26 Avril 2020

Re

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

VB:

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 · 26 Avril 2020

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 · 26 Avril 2020

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

voici le fichier

Noopy123 · 26 Avril 2020

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 · 26 Avril 2020

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 · 26 Avril 2020

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 · 26 Avril 2020

Re

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

Pour le reste: 6x6=36

VB:

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 · 26 Avril 2020

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 · 26 Avril 2020

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 · 26 Avril 2020

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 :

VB:

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 · 26 Avril 2020

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 · 26 Avril 2020

Re

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

Nommer suite de shape

Noopy123

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Noopy123

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Aligner rectangle

Multipostage — Wikipédia

Noopy123

XLDnaute Junior

Pièces jointes

Noopy123

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Noopy123

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Noopy123

XLDnaute Junior

Noopy123

XLDnaute Junior

Noopy123

XLDnaute Junior

Noopy123

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Discussions similaires