Gestion des objets (shapes)

[joums]

Bonjour à tous,

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

'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

Je vous remercie de votre aide

 

[HIJACK]

Re : Gestion des objets (shapes)

Salut,
Un truc vite fait à modifier et à peaufiner.

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

 

[joums]

Re : Gestion des objets (shapes)

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+

 

[liloucmoi]

Re : Gestion des objets (shapes)

Bonjour joums, HIJACK,

seulement ce code nommera automatique tous les shapes

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 :

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

Xldment.
++