Déplacement d'images

[Hulk]

Bonsoir à tous 🙂

J'ai pas loin de 500 images éparpillées un peu partout dans la Feuil1.

Elles sont nommées de "Image 1" à "Image 500".

Pour l'exemple il n'y a que 10 images.

Je souhaiterais les disposer en colonne A l'une sous l'autre, mais je n'y arrive pas :-(

Image 1 en A1
Image 2 en A2
Image 3 en A3
Etc.

Fichier à prendre ICI.

Je vous remercie pour votre aide !

Bonne soirée à tous !

 

[hbenalia]

Re : Déplacement d'images

Bonjour à tous, bonjour Hulk

J'ai une petite idée mais il faudrait que les images soient au moins ordonnées (par noms) horizontalement (par groupes peut être mais presque même niveau), éparpillées comme dans l'exemple je ne peux les ordonner... Si condition satisfaite on peut suivre les étapes suivantes:

1- Appuyer sur la touche F5
2- Choisir "Cellules" puis "Objets" puis OK
3- Via la barre d'outils dessin, choisir "Dessin" puis "Aligner ou répartir"
4- Choisir "Aligner à gauche" ou "Centrer" ou "Aligner à droite"
5- Déplacer la sélection à l'aide de la souris vers la cellule A1
6- Appuyer sur "Echap" pour déselectionner...
7- Déplacer "Image 500" vers la cellule A500
8- Répéter les étapes de 1 à 3
9- Choisir "Distribuer verticalement"
10- Le tour est joué

NB: Si la condition citée plus haut n'est pas satisfaite les images seront réparties de la cellule A1 à la cellule A500 mais désordonnées...


Cordialement

 

[hbenalia]

Re : Déplacement d'images

Bonjour le forum, bonjour Hulk


Si tu travailles sur Excel 2007 ou plus, tu peux utiliser le code VBA (Macro) suivant:

Sub Arranger()
Dim I As Integer
For I = 1 To 500
ActiveSheet.Shapes("Picture " & I).Select
Selection.Cut
Cells(I, 1).Select
ActiveSheet.Paste
Next I
End Sub

NB: Si on a plus de 500 images on change le 500 dans le code par le nombre approprié, sinon le code annonce une erreur de débogage qu'on arrête...

J'espère avoir venir à ton aide....

Cordialement

 

[Mytå]

Re : Déplacement d'images

Salut le forum

La macro suivante fonctionne très bien

Sub images()
Dim I As Integer

For I = 1 To 500
  With ActiveSheet.Shapes("Picture " & I)
    .Top = Cells(I, 1).Top
    .Left = Cells(I, 1).Left
  End With
Next I

End Sub

Mytå

 

[Hulk]

Re : Déplacement d'images

Bonjour Forum, hbenalia, Mytå,

Merci pour vos solutions.

Je vais opter pour celle de Mytå...

Merci encore à vous deux et bonne semaine à tous !