Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

VBA : Sélectionner trois formes sans les nommer

12 réponses
Avatar
garnote
Bonjour,

J'ai ici une macro qui connecte deux rectangles
et sélectionne le connecteur et les deux rectangles.
Elle fonctionne correctement mais je me demande
s'il serait possible de sélectionner les trois formes
sans les nommer.
J'ai essayé sans succès :
Set tous = S.Range(Array(R1, R2, C))

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = "un"
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = "deux"
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
C.Name = "trois"
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
Set tous = S.Range(Array("un", "deux", "trois"))
tous.Select
End Sub

Serge enneigé (ça commence raide à Québec)

10 réponses

1 2
Avatar
garnote
ReBonjour,

Légère amélioration :
S'il n'y a, sur la première feuille, que les trois formes créées par la macro,
je peux me passer des noms :

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 2
End With
C.RerouteConnections
S.Range(Array(1, 2, 3)).Select
End Sub

Mais s'il y a d'autres formes sur la feuille, ça ne va plus.
Il y a sûrement un truc pour se référer aux variables
R1, R2 et S, non ?

Serge


"garnote" a écrit dans le message de news:
Bonjour,

J'ai ici une macro qui connecte deux rectangles
et sélectionne le connecteur et les deux rectangles.
Elle fonctionne correctement mais je me demande
s'il serait possible de sélectionner les trois formes
sans les nommer.
J'ai essayé sans succès :
Set tous = S.Range(Array(R1, R2, C))

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = "un"
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = "deux"
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
C.Name = "trois"
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
Set tous = S.Range(Array("un", "deux", "trois"))
tous.Select
End Sub

Serge enneigé (ça commence raide à Québec)



Avatar
isabelle
salut Serge,

Sub Connecteur1()
forme = Array("un", "deux", "trois")
Set f = Worksheets(1)
Set s = f.Shapes
Set R1 = s.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = forme(0)
Set R2 = s.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = forme(1)
Set C = s.AddConnector(msoConnectorCurve, _
350, 50, 100, 100)
C.Name = forme(2)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
s.Range(Application.Transpose(forme)).Select
End Sub


garnote a écrit :
Serge enneigé (ça commence raide à Québec)




pour une fois on a été épargné :-)
bon pelletage,
isabelle
Avatar
garnote
Salutatoi Isabelle,

Ta macro me renvoie "Erreur d'exécution 1004".
Et tu donnes des noms à R1, R2 et C; ce que
j'aimerais éviter.

Serge



"isabelle" a écrit dans le message de news: Ov2s$
salut Serge,

Sub Connecteur1()
forme = Array("un", "deux", "trois")
Set f = Worksheets(1)
Set s = f.Shapes
Set R1 = s.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = forme(0)
Set R2 = s.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = forme(1)
Set C = s.AddConnector(msoConnectorCurve, _
350, 50, 100, 100)
C.Name = forme(2)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
s.Range(Application.Transpose(forme)).Select
End Sub


garnote a écrit :
Serge enneigé (ça commence raide à Québec)



pour une fois on a été épargné :-)
bon pelletage,
isabelle


Avatar
isabelle
salut Serge,

tu as le message d'erreur sur quel ligne ?
ps/ je n'ai pas choisi R1, R2 et C , je l'ai repris de ton exemple avec Set,

http://cjoint.com/?mksYFiMFmZ

isabelle

garnote a écrit :
Salutatoi Isabelle,

Ta macro me renvoie "Erreur d'exécution 1004".
Et tu donnes des noms à R1, R2 et C; ce que
j'aimerais éviter.

Serge



"isabelle" a écrit dans le message de news: Ov2s$

salut Serge,

Sub Connecteur1()
forme = Array("un", "deux", "trois")
Set f = Worksheets(1)
Set s = f.Shapes
Set R1 = s.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = forme(0)
Set R2 = s.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = forme(1)
Set C = s.AddConnector(msoConnectorCurve, _
350, 50, 100, 100)
C.Name = forme(2)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
s.Range(Application.Transpose(forme)).Select
End Sub


garnote a écrit :

Serge enneigé (ça commence raide à Québec)



pour une fois on a été épargné :-)
bon pelletage,
isabelle








Avatar
garnote
Salut Isabelle,

tu as le message d'erreur sur quel ligne ?



Ici : s.Range(Application.Transpose(forme)).Select

ps/ je n'ai pas choisi R1, R2 et C , je l'ai repris de ton exemple avec Set,



Au lieu d'utiliser :
S.Range(Array(1, 2, 3)).Select
dans cette macro :

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 2
End With
C.RerouteConnections
S.Range(Array(1, 2, 3)).Select
End Sub

je voudrais utiliser les variables R1, R2 et C
sans leur donner de noms.
Mais est-ce possible ?

Serge
Avatar
isabelle
pas sur de bien comprendre :

Sub Connecteur2()
forme = Array(R1, R2, C)
Set f = Worksheets(1)
Set s = f.Shapes
Set forme(0) = s.AddShape(msoShapeRectangle, 100, 50, 200, 100)
Set forme(1) = s.AddShape(msoShapeRectangle, 300, 300, 200, 100)
Set forme(2) = s.AddConnector(msoConnectorCurve, 350, 50, 100, 100)
With forme(2).ConnectorFormat
.BeginConnect forme(0), 1
.EndConnect forme(1), 1
End With
forme(2).RerouteConnections
For i = LBound(forme) To UBound(forme)
s.Range(forme(i).Name).Select Replace:úlse
Next
End Sub

isabelle

garnote a écrit :
Salut Isabelle,


tu as le message d'erreur sur quel ligne ?




Ici : s.Range(Application.Transpose(forme)).Select


ps/ je n'ai pas choisi R1, R2 et C , je l'ai repris de ton exemple avec Set,




Au lieu d'utiliser :
S.Range(Array(1, 2, 3)).Select
dans cette macro :

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 2
End With
C.RerouteConnections
S.Range(Array(1, 2, 3)).Select
End Sub

je voudrais utiliser les variables R1, R2 et C
sans leur donner de noms.
Mais est-ce possible ?

Serge





Avatar
michdenis
3 façons de sélectionner les shapes créées :

'------------------------------------------
Sub Connecteur()
Dim F As Worksheet, S As Shapes, Tous As ShapeRange
Dim R1 As Shape, R2 As Shape, C As Shape
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = "un"
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = "deux"
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
C.Name = "trois"
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections

'***** Une façon de faire ******
'Set Tous = S.Range(Array("un", "deux", "trois"))
'Tous.Select
'***** OU Une seconde façon de faire ****
' S.SelectAll
'***** OU troisième façon *****
S.Range(Array("un", "deux", "trois")).Select
End Sub
'------------------------------------------

Ou si tu préfères, tu pourrais définir ton "Array" de cette manière :
S.Range(Array(R1.Name, R2.Name, C.Name)).Select

Tu peux aussi utiliser leur index
S.Range(Array(1, 2, 3)).Select
End Sub








"garnote" a écrit dans le message de news:

Bonjour,

J'ai ici une macro qui connecte deux rectangles
et sélectionne le connecteur et les deux rectangles.
Elle fonctionne correctement mais je me demande
s'il serait possible de sélectionner les trois formes
sans les nommer.
J'ai essayé sans succès :
Set tous = S.Range(Array(R1, R2, C))

Sub Connecteur()
Set F = Worksheets(1)
Set S = F.Shapes
Set R1 = S.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Name = "un"
Set R2 = S.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Name = "deux"
Set C = S.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
C.Name = "trois"
With C.ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
C.RerouteConnections
Set tous = S.Range(Array("un", "deux", "trois"))
tous.Select
End Sub

Serge enneigé (ça commence raide à Québec)
Avatar
garnote
Bonjour Isabelle et Denis,

Merci à vous deux.

Voilà où je voulais en venir :
Une méthode générale permettant de
sélectionner les formes ajoutées par
une macro sur la feuille active.

Sub Sélectionne_Formes_Ajoutées()
Set f = ActiveSheet
n = f.DrawingObjects.Count
Set s = f.Shapes
Set R1 = s.AddShape(msoShapeRectangle, _
200, 50, 50, 100)
Set R2 = s.AddShape(msoShapeRectangle, _
300, 300, 80, 90)
Set E = s.AddShape(msoShape5pointStar, _
100, 300, 100, 100)
Set C = s.AddShape(msoShapeCube, _
50, 50, 50, 50)
na = f.DrawingObjects.Count - n
For i = n + 1 To n + na
s.Range(f.DrawingObjects(i).Name).Select Replace:úlse
Next i
End Sub

Exemple : http://cjoint.com/?mlmqHY5hxy

Serge
Avatar
michdenis
"DrawingObjects" ne fait plus parti du modèle objet d'excel
depuis la version 2000 bien qu'il existe encore pour une
question de compatibilité !

Je suppose que tu pourrais remplacer la collection
"Drawingobjects" par la collection "Shapes" et tu
obtiendrais le même résultat.

Une boucle bien que souvent utile n'est pas la façon la
plus élégante de procéder si on peut faire sans !

Une autre suggestion :

Sub test()
Dim F As Worksheet, S As Shapes, Tous As ShapeRange
Dim R1 As Shape, R2 As Shape, C As Shape
With Worksheets(1)
Set R1 = .Shapes.AddShape(msoShapeRectangle, _
100, 50, 200, 100)
R1.Select False
Set R2 = .Shapes.AddShape(msoShapeRectangle, _
300, 300, 200, 100)
R2.Select False
With .Shapes.AddConnector(msoConnectorCurve, _
0, 0, 100, 100)
With .ConnectorFormat
.BeginConnect R1, 1
.EndConnect R2, 1
End With
.RerouteConnections
.Select False
End With
End With
End Sub

Et si tu n'avais pas le connecteur tu pourrais écrire ceci
avec la création d'autant de "Shape" que tu désires
'--------------------------
Sub test()
Dim F As Worksheet, S As Shapes, Tous As ShapeRange
Dim R1 As Shape, R2 As Shape, C As Shape
With Worksheets(1)
.Shapes.AddShape(msoShapeRectangle, _
100, 50, 200, 100).Select False
.Shapes.AddShape(msoShapeRectangle, _
300, 300, 200, 100).Select False
End With
End Sub
'--------------------------



"garnote" a écrit dans le message de news:

Bonjour Isabelle et Denis,

Merci à vous deux.

Voilà où je voulais en venir :
Une méthode générale permettant de
sélectionner les formes ajoutées par
une macro sur la feuille active.

Sub Sélectionne_Formes_Ajoutées()
Set f = ActiveSheet
n = f.DrawingObjects.Count
Set s = f.Shapes
Set R1 = s.AddShape(msoShapeRectangle, _
200, 50, 50, 100)
Set R2 = s.AddShape(msoShapeRectangle, _
300, 300, 80, 90)
Set E = s.AddShape(msoShape5pointStar, _
100, 300, 100, 100)
Set C = s.AddShape(msoShapeCube, _
50, 50, 50, 50)
na = f.DrawingObjects.Count - n
For i = n + 1 To n + na
s.Range(f.DrawingObjects(i).Name).Select Replace:úlse
Next i
End Sub

Exemple : http://cjoint.com/?mlmqHY5hxy

Serge
Avatar
garnote
Salut Denis

"DrawingObjects" ne fait plus parti du modèle objet d'excel
depuis la version 2000 bien qu'il existe encore pour une
question de compatibilité !


Pas en retard à peu près suis-je !

Je suppose que tu pourrais remplacer la collection
"Drawingobjects" par la collection "Shapes" et tu
obtiendrais le même résultat.


Pas toujours, par exemple si ma feuille contient
des affaires de la boîte à outils Formulaires ou Contrôles.
Voir mon exemple sur Cjoint.

Une boucle bien que souvent utile n'est pas la façon la
plus élégante de procéder si on peut faire sans !


Alors là c'est l'élégance absolue. Ma macro devient :

Sub Sélectionne_Formes_Ajoutées()
With ActiveSheet
.Shapes.AddShape(msoShapeRectangle, _
200, 50, 50, 100).Select False
.Shapes.AddShape(msoShapeRectangle, _
300, 300, 80, 90).Select False
.Shapes.AddShape(msoShape5pointStar, _
100, 300, 100, 100).Select False
.Shapes.AddShape(msoShapeCube, _
50, 100, 50, 50).Select False
End With
End Sub

Connaissais pas Select False.
Pas encore prêt pour participer à des concours
de macros brèves et efficaces !

Merci et bonne journée, Ô grand simplificateur ;-)

Serge
1 2