Déplacer un shape de dx et dy

Bonjour,

J'aurais besoin d'aide pour écrire un code vba qui me permet de déplacer un shape que je sélectionne avec la sourie puis en saisissant la valeur de dx et dy, le shape en question se déplace.

merci

cordialement

Bonsoir Didier0901, le forum,

Une piste.....

Avec un bouton "Bouton 1" sur la feuille "Feuil1".

Sub Bouton1_Cliquer()
 Dim x, y
  On Error Resume Next
  x = InputBox("Entrez une valeur :", "Déplacement horizontal")
  y = InputBox("Entrez une valeur :", "Déplacement vertical")
    Sheets("Feuil1").Shapes("Bouton 1").Left = x
    Sheets("Feuil1").Shapes("Bouton 1").Top = y
End Sub

Cordialement,

bonjour xorsankukai,

Merci pour ta réponse, l'objectif est de déplacer un shape sélectionné par la sourie par l'intermédiaire des valeur dx et dy saisie par le bouton.

cordialement

Bonjour Xor (car moi j'ai fait mon choix !)

Sub Deplacement()
 Dim x, y,Nom
  On Error Resume Next
  x = InputBox("Entrez une valeur :", "Déplacement horizontal")
  y = InputBox("Entrez une valeur :", "Déplacement vertical")
Nom = Application.Caller
    Sheets("Feuil1").Shapes(Nom).Left = x
    Sheets("Feuil1").Shapes(Nom).Top = y
End Sub

Il faut attribuer à votre shape cette procédure par un clic droit puis "affecter une macro"

@ bientôt

LouReeD

Bonjour Didier0901, LouReed, le forum,

@Lou () : merci pour ton intervention et cette astuce avec le nom

Amitiés,

bonjour LouReeD,

on ne peux pas, sélectionner le rectangle avec la sourie, puis appuis sur le bouton, saisir dx et dy pour faire déplacer le rectangle et non pas le bouton et cela dépend de la sélection faite par la sourie,

merci

cordialement

Re,

on ne peux pas, sélectionner le rectangle avec la sourie, puis appuis sur le bouton, saisir dx et dy pour faire déplacer le rectangle et non pas le bouton et cela dépend de la sélection faite par la sourie,

Quel bouton ?

Il faut attribuer à votre shape cette procédure par un clic droit puis "affecter une macro"

Cordialement,

Re,

En fait ce que je veux c'est créer un shape et sans avoir à chaque fois lui affecter la macro, je le sélectionne puis, je clic sur un bouton qui m'ouvre une fenêtre me demandant dx et dy et en appliquant le shape sélectionné au début se déplace de dx dy.

En fait il faut que la sélection par la sourie précise que c'est ce shape qui est sélectionné qu'il faudra déplacer

merci

cordialement

Re,

J'ai trouvé une solution par contre le seule problème qui reste c'est que le x et y que j'introduit sont des positions, moi ce que je veux c'est les déplacer de dx et dy par rapport à leur position actuelle, pour cela il faudrait récupérer leur position x et y actuelle et faire x+dx, y+dy, ou sinon s'il y a un autre moyen d'introduire dx et dy directement

merci

cordialement

Shape. Left = shape. Left + dx

C'est le principe, pas la syntaxe !

Sinon qu'elle est votre solution ? Elle peut servire à d'autre.

@ bientôt

LouReeD

Re,

J'ai fais un with selection

.left

.top

par contre dès que je sélectionne plusieurs shapes ça ne marche plus, si quelqu'un aurait une idée ?

cordialement

Re,

Peut-être ainsi:

Sub Deplacement()
 Dim x, y, BT
  On Error Resume Next
  x = InputBox("Entrez une valeur :", "Déplacement horizontal")
  y = InputBox("Entrez une valeur :", "Déplacement vertical")
   With Selection
    For Each BT In Selection
     BT.Left = BT.Left + x
     BT.Top = BT.Top + y
    Next BT
   End With
End Sub

Cordialement,

Re,

Merci pour le code, par contre il y a un problème que je ne comprends pas, quand je fais un arc et que je dis que dx=0 et dy<>0, il se déplace quand même selon x

quelqu'un aurait il une idée pourquoi?

cordialement