J'ai besoin de votre aide car je sèche sur ce problème.
J'aimerai déplacer des images (shapes).
Je vous explique le contexte :
J'ai un nombre d'images qui peut être variable,
Ces images doivent se déplacer
Je ne connais aucun parametre de ces images :
- nom
- valeur (top et left)
Je réussi à déplacer une image (je connais son nom)
Je définit la position de départ de l'objet
puis la position final
Ensuite la différence = au déplacement de cet objet.
Par une boucle où j'incrémente +1 à chaque fois, j'obtiens bien le déplacement pour un objet.
Le probleme se corse à partir du moment où je souhaite déplacer plusieurs images en même temps, sachant que je ne connais pas ni leur nom ni leur position (top, left)
Voici le bout de code que j'utilise
Code:
'1ere partie : je récupere la position de la shape
Set Img1 = ActiveSheet.shapes("rectangle1")
Set Img2 = ActiveSheet.shapes("picture1")
X = Img2.Left - (Img1.Width + Img1.Left)
Y = Img2.Top - (Img1.Height + Img1.Top)
'2e partie : je définit le déplacement
Dim i As Integer, initop1 As Single, finaltop1 As Single
initop1 = ActiveSheet.shapes("picture1").Top
finaltop1 = ActiveSheet.shapes("picture1").Top + Range("D14").Value
inileft1 = ActiveSheet.shapes("picture1").Left
finalleft1 = ActiveSheet.shapes("picture1").Left + Range("C14").Value
For i = 1 To 100
ActiveSheet.shapes("picture1").Top = initop1 - (finaltop1 - initop1) / 100 * i
ActiveSheet.shapes("picture1").Left = inileft1 - (finalleft1 - inileft1) / 100 * i
Sleep 50
DoEvents
Next i
Salut,
Un truc vite fait à modifier et à peaufiner.
Code:
Sub Macro1()
Dim img, nom(10), haut(10), gauch(10), n°
n° = 1
' Macro1 Macro
For Each img In ActiveSheet.Shapes
nom(n°) = img.Name
haut(n°) = img.Top
gauch(n°) = img.Left
n° = n° + 1
Next
End Sub
Bonjour,
merci pour la réponse,
seulement ce code nommera automatique tous les shapes
mais comment récupérer la valeur de tous les shapes
peut etre en créant une variable ?
je vous tiens au courant
si vous avez une idée n'hésitez pas
merci
A+
Il me semble que ce code va stocker dans un premier tableau le nom de chaque image de la feuille, puis dans deux autres tableaux les positions top et left de chaque image de la feuille.
Si tu as un nombre d'images inconnu dans ta feuille :
Code:
Sub images()
Dim img As Shape
Dim nom(), haut(), gauch(), n° As Integer
n° = 0
For Each img In ActiveSheet.Shapes
ReDim Preserve nom(n°)
ReDim Preserve haut(n°)
ReDim Preserve gauch(n°)
nom(n°) = img.Name
haut(n°) = img.Top
gauch(n°) = img.Left
n° = n° + 1
Next img
For n° = LBound(nom) To UBound(nom)
MsgBox (nom(n°) & " is at " & haut(n°) & " from the top and " & gauch(n°) & " from the left.")
Next n°
End Sub