VBA : Sélectionner trois formes sans les nommer

Le
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)
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
garnote
Le #18102351
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"
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)



isabelle
Le #18103781
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
garnote
Le #18103931
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


isabelle
Le #18104171
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








garnote
Le #18104151
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
isabelle
Le #18104731
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





michdenis
Le #18105421
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"
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)
garnote
Le #18111011
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
michdenis
Le #18111651
"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"
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
garnote
Le #18111831
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
Publicité
Poster une réponse
Anonyme