Déplacement des formes créées à l'endroit du clic

Bonjour,

J'ai mis en place un bouton qui me crée automatique des formes selon le nombre que je choisi. J'aimerai que lors de ma validation et de la création des formes, elles soient toutes sélectionnées et qu'elles se positionnent à l'endroit du clic de ma souris. Par exemple, j'aimerai qu'elles suivent ma souris jusqu'à mon clic et une fois cliqué, elles se placent à cet endroit.

Dans mon code je crée mes formes à la suite dans une macro comme l'exemple suivant :

For i = 1 To UserForm4.TextBox2 * 1
    gauche = 310 + i * 10
    haut = 30 + 5 * i
    largeur = 30
    hauteur = 200
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, gauche, haut, largeur, hauteur).Select
    Selection.ShapeRange.Fill.Transparency = 0.5

Next i

Les codes des autres formes ressemblent à cela et se suivent dans la macro.

Merci pour votre aide !

Pour peut être donner des idées à certains, je me disais qu'il fallait peut être créer une collection de shape, les ajouter à cette collection au fur et à mesure de leur création puis la sélectionner pour la bouger où on veut ?? Si ça peut en inspirer certains...

Merci pour votre aide précieuse !

Bonjour Azerty_01,

Ce n'est pas très clair pour moi ... tu veux créer plusieurs formes au même endroit ou à des endroits différents ? puis les sélectionner toutes pour les déplacer en bloc à l'endroit du positionnement de la souris ? Un exemple du résultat que tu souhaites serait le bienvenu ou mieux le fichier (anonymisé si besoin).

L'exemple joint propose une alternative en macro séquences : 1- ouverture du formulaire, 2- sélection de l'endroit où positionner l'angle supérieur gauche de la cellule, 3- cliquer sur le bouton qui crée la forme à l'endroit voulu, 4- refaire : 2 et 3 n fois ou refaire 3 n fois.

Bonjour Cylfo,

Je ne peux malheureusement pas envoyer mon fichier mais je vais tâcher de l'expliquer au mieux. J'ai mes macros qui créent les formes que je souhaite en fonction de la validation des valeurs d'une UserForm comme dans le code suivant :

For i = 1 To UserForm4.TextBox2 * 1
    gauche = 310 + i * 10
    haut = 30 + 5 * i
    largeur = 30
    hauteur = 200
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, gauche, haut, largeur, hauteur).Select
    Selection.ShapeRange.Fill.Transparency = 0.5
Next i

ActiveSheet.Shapes.AddShape(msoShapeOval, 310 + i * 10, 30 + 5 * i, 80, 80).Select
Selection.ShapeRange.Fill.Transparency = 0.5

Dim FB As FreeformBuilder
' Propriétés de la forme libre
Set FB = ActiveSheet.Shapes.BuildFreeform _
(msoEditingAuto, 390, 60)
FB.AddNodes msoSegment, msoEditingAuto, 390, 120
FB.AddNodes msoSegment, msoEditingAuto, 390, 180
FB.AddNodes msoSegment, msoEditingAuto, 360, 180
FB.AddNodes msoSegment, msoEditingAuto, 330, 180
FB.AddNodes msoSegment, msoEditingAuto, 330, 120
FB.AddNodes msoSegment, msoEditingAuto, 330, 60
FB.AddNodes msoSegment, msoEditingAuto, 360, 60
FB.AddNodes msoSegment, msoEditingAuto, 390, 60
' Dessinez la forme libre comme une forme
Set Sh = FB.ConvertToShape
Sh.Fill.Transparency = 0.5

Elles apparaissent donc à l'endroit défini lors de la validation de la UserForm.

Ce que j'aimerai, c'est qu'elles ne se positionnent pas tant que je n'ai pas cliqué avec ma souris. J'avais défini leur position pour tester mais désormais j'aimerai qu'elles apparaissent à l'endroit du click de ma souris et non plus aux coordonnées que j'avais rentré.

J'espère que mon explication était claire.

Merci pour votre aide !

Par exemple, si tu crées 3 formes, elles se positionneraient :

• toutes au même endroit au 1er clic de souris ?
• tu cliquerais à 3 endroits différents ?
• après chaque création suite tu ferais un clic pour positionner la forme ?
• le positionnement est il relatif par rapport à la cellule (un angle, au milieu, au 3/4, ...) dans lequel le clic se produit ?

Le userform ne sert qu'à la création des formes ou ce n'est qu'une petite partie des fonctionnalités du formulaire ?

Bonjour Cylfo,

Je m'excuse pour la lenteur de ma réponse.

Ce UserForm sert à créer les formes mais je me sers également des données de ses ListBox pour une autre partie de mon projet.

Pour votre exemple des 3 formes :

- L'idée est d'en effet toutes les positionner au même endroit. J'ai mon plan en fond et je veux positionner toutes les formes en même temps à l'endroit adéquat.

- Les créations ne sont pas différenciées puisque toutes les formes sont crées en même temps.

- Je ne clique pas réellement sur une cellule puisque je clique sur mon plan à l'endroit que je veux.

En espérant que ce soit encore un peu plus clair

Peux-tu préciser ce que tu appelles le plan en fond ? c'est une autre forme ? (si oui, indiques le type d'objet)

C'est une image d'un plan type plan architecte

Si ma demande semble impossible, j'aimerai à minima qu'elles soient toutes sélectionnées quand elles apparaissent pour que je puisse les déplacer manuellement toutes en même temps

Le fichier joint correspond-il plus à ta demande ? Une fois les objets créés, tu peux les déplacer et continuer à en recréer d'autres si cela à un sens.

Pour mon second choix c'est parfait car cela sélectionne toutes les formes en même temps et je peux les placer à ma guise !

Pour mon histoire du placement au clic cela ne t'as pas inspiré ?

Je suis désolé mais je suis embêté, j'ai du mal à adapter ton deuxième fichier à mon code. Comme tu peux le voir j'ai également une boucle For pour la création du nombres de rectangle qui lui est défini par la réponse à la UserForm. Cependant, peu importe le nombre de rectangle nécessaire, j'ajoute également un cercle et deux formes libres quoi qu'il arrive. Je ne vois pas comment je peux les mettre également dans la boucle pour qu'elles soient sélectionnées également.

Merci beaucoup pour ton aide!

Les formes sont sélectionnées via le tableau acShape et l'instruction "ActiveSheet.Shapes.Range(acShape).Select".

Si tu remplaces "ReDim acShape(0 To nNbShape - 1)" en "ReDim acShape(0 To nNbShape - 1 + x)" (où x est le nombre de formes ajoutées en dehors de la boucle) et que tu transformes

ActiveSheet.Shapes.AddShape(msoShapeOval, 310 + i * 10, 30 + 5 * i, 80, 80).Select
Selection.ShapeRange.Fill.Transparency = 0.5

en

Set shTmp = ActiveSheet.Shapes.AddShape(msoShapeOval, 310 + i * 10, 30 + 5 * i, 80, 80)
shTmp.Fill.Transparency = 0.5
acShape(NbShape) = shTmp.name
' Faire de même pour les autres formes que tu ajoutes (sans faire de .select) en incrémentant, à partir de cette ligne, nNbShape de 1 avant chaque ajout du nom du shape créé dans le tableau acShape.
...
...
ActiveSheet.Shapes.Range(acShape).Select     

Cela devrait solutionner le problème

Pour le "placement au clic", une fois que tu aurais cliqué et que les formes seraient positionnées à la position de la souris, il se passe quoi ? le formulaire est fermé ? tu repositionnes d'autres formes ? autres ?

Ok super merci pour ça !

Pour le "placement au clic", l'idée serait que le formulaire se ferme au moment de la validation comme actuellement et une fois cliqué à l'endroit, les formes se positionnent et ensuite il est possible d'en recréer d'autres et de les placer à un autre clic et ainsi de suite...

Si le "placement au clic" inspire quelqu'un je suis toujours preneur !

Merci énormément

Bonjour Azerty_01,

J'ai fait des recherches sur le sujet et essayé quelques "trucs" mais sans succès. Le clic (du bouton gauche) est intercepté / géré par Excel et il n'y a pas d'évènement qui gère le clic gauche. Donc si les formes sont sélectionnées et que tu cliques dans le plan, tu sélectionnes le plan et tu désélectionnes les formes ! Sans parler qu'il faudrait gérer le clic consécutivement à la fermeture du formulaire ...

Bonjour,

Je me doutais que cela pourrait être compliqué. Je te remercie grandement pour ton aide et te souhaite une bonne continuation !

Bonjour, je suis embêté en vous récrivant ici car je n'arrive pas à faire tourner le code avec l'ajout successif de mes formes. Cela ne me sélectionne que le cercle et à chaque fois un rectangle de moins que demandé. Il reste deux formes libres à sélection et une croix et malheureusement je n'arrive pas à les sélectionner. Voici mon code actuel. Merci pour votre aide.

Sub creashapes()

Dim shTmp As Shape
Dim nNbShape As Long
Dim i As Long
Dim acShape() As String

Application.CutCopyMode = xlCopy
' Pour désélectionner les objets précédemment sélectionnés en cas d'insertion successives ed formes
ActiveSheet.Range("A1").Select

nNbShape = CLng(CréationPièce.TextBox2.Text)

ReDim acShape(0 To nNbShape - 1 + X)

For i = 0 To nNbShape - 1
    gauche = 310 + i * 10
    haut = 30 + 5 * i
    largeur = 30
    hauteur = 200
    Set shTmp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, gauche, haut, largeur, hauteur)
    shTmp.Fill.Transparency = 0.5
    acShape(i) = shTmp.Name
Next i

'Création Croix

Set shTmp = ActiveSheet.Shapes.AddShape(msoShapeCross, 310 + i * 10, 30 + 5 * i, 20, 20)
shTmp.Fill.Transparency = 0.5
acShape(NbShape) = shTmp.Name
nNbShape = nNbShape + 1

'Création Surface

Dim FB As FreeformBuilder
' Propriétés de la forme libre
Set FB = ActiveSheet.Shapes.BuildFreeform _
(msoEditingAuto, 390, 60)
FB.AddNodes msoSegment, msoEditingAuto, 390, 120
FB.AddNodes msoSegment, msoEditingAuto, 390, 180
FB.AddNodes msoSegment, msoEditingAuto, 360, 180
FB.AddNodes msoSegment, msoEditingAuto, 330, 180
FB.AddNodes msoSegment, msoEditingAuto, 330, 120
FB.AddNodes msoSegment, msoEditingAuto, 330, 60
FB.AddNodes msoSegment, msoEditingAuto, 360, 60
FB.AddNodes msoSegment, msoEditingAuto, 390, 60
' Dessinez la forme libre comme une forme
Set shTmp = FB.ConvertToShape
shTmp.Fill.Transparency = 0.5
acShape(NbShape) = shTmp.Name
nNbShape = nNbShape + 1

'Création Surface

Dim LB As FreeformBuilder
' Propriétés de la forme libre
Set LB = ActiveSheet.Shapes.BuildFreeform _
(msoEditingAuto, 390, 60)
LB.AddNodes msoSegment, msoEditingAuto, 390, 120
LB.AddNodes msoSegment, msoEditingAuto, 390, 180
LB.AddNodes msoSegment, msoEditingAuto, 360, 180
LB.AddNodes msoSegment, msoEditingAuto, 330, 180
LB.AddNodes msoSegment, msoEditingAuto, 330, 120
LB.AddNodes msoSegment, msoEditingAuto, 330, 60
LB.AddNodes msoSegment, msoEditingAuto, 360, 60
LB.AddNodes msoSegment, msoEditingAuto, 390, 60
' Dessinez la forme libre comme une forme
Set shTmp = FB.ConvertToShape
shTmp.Fill.Visible = msoFalse
shTmp.Line.Weight = 7
acShape(NbShape) = shTmp.Name
nNbShape = nNbShape + 1

'Création Cercle

Set shTmp = ActiveSheet.Shapes.AddShape(msoShapeOval, 310 + i * 10, 30 + 5 * i, 80, 80)
shTmp.Fill.Transparency = 0.5
shTmp.ZOrder msoBringToFront
acShape(NbShape) = shTmp.Name
nNbShape = nNbShape + 1

ActiveSheet.Shapes.Range(acShape).Select
End Sub

Juste avec le code et sans fichier ... bon ... dans ReDim acShape(0 To nNbShape - 1 + X) où est initialisé X ?