XL 2013 déplacer beaucoup de photos vers un emplacement précis

[Usine à gaz]

Bonjour à toutes et à tous,

Je butte sur un nouveau problème et malgré mes recherches et tentatives, je n'y arrive pas.

J'ai dans un fichier beaucoup de photos importées de 300 à 5000 voire plus.
Ces photos ne sont pas placées les unes au-dessous des autres. Il y a 8 à 10 lignes en chaque photos
Dans le fichier exemple joint, elles sont dans l'onglet Photos.

Dans mon onglet "destination", dans la colonne B, j'ai des noms sur les lignes qui se suivent.
Les photos de l'onglet "photos" sont dans le même ordre que les noms de la feuille "destination".

Ma question
Est-il possible par macro de copier les photos de la feuille "photos" dans la feuille "destination" dans la colonne A à partir de la ligne 3, à la suite : 1 photo dans chaque cellule en descendant (comme montré dans la colonne C de la feuille "destination").

LOL, à l'appui de mes explications vaseuses (comme diront certains), je joins le fichier test qui contient 10 photos pour le test.

Si quelqu'un a une idée, ça m'arrangerait bien
Avec mes remerciements,
Je vous souhaite à toutes et à tous une belle fin de journée,
Amicalement,
arthour973

 

[Staple1600]

Bonjour le fil, le forum

Si quelqu'un a une idée, ça m'arrangerait bien

Une idée*, peut être
Une préconisation sans doute:
Excel est d'abord un tableur
Pas un logiciel de gestions d'images (comme IrfanView ou autres viewers dédiés à cette tâche)
Pour décapsuler une bière, je prends un décapsuleur, pas un marteau ou cric automobile

*; donc ci-dessous l'idée

Sub test()
Dim i&, a$
For i = 1 To ActiveSheet.Shapes.Count
    With ActiveSheet.Shapes(i)
        Select Case .Type
        Case msoPicture
        'juste pour test
        'MsgBox .Name
        'Msgbox .TopLeftCell.Address
        a = .TopLeftCell.Address
        .Copy
        Sheets("destination").Range(a).PasteSpecial
        End Select
        a = ""
    End With
Next
End Sub

PS: je n'ose imaginer la souffrance d'Excel avec 5000 photos ...

 

[Usine à gaz]

Bonsoir JM,
Merci d'être là,
Effectivement y peut y avoir souffrance et c'est moi qui souffre LOL.
Merci pour ton code mais ça ne fonctionne pas car j'ai juste besoin de copier les photos de la feuille photos dans la feuille destination.
Je continue mes recherches
Bonne fin de journée,
Amicalement,
arthour973

 

[Staple1600]

Re

@arthour973
Si cela fonctionne*, j'ai testé sur ton fichier!
C'es bien pour cela que j'ai publié le code.
Mais comme précisé, c'est une idée (donc pas une solution clé en mains)

Par contre que tu n'arrives pas à faire fonctionner mon code, c'est une autre histoire

*: les deux photos présentes sur la feuille photos sont bien copiées dans la feuille destination.
Pour le reste, c'est à développer (...ou pas) au vu du nombre de photos potientiellement contenu dans ton classeur.

 

[Lone-wolf]

Bonsoir Lionel, Jean Marie, Le Forum

@arthour973

Lionel, tu as un reçu, un coup de marteau ou un coup de cric sur la tête?! Mis à part les msgbox, c'est bien ce que fait la macro que Jean Marie t'as montré.

 

[Staple1600]

Re

Bonsoir Lone-Wolf
Merci de confirmer mes propos

 

[Usine à gaz]

Re

@arthour973
Si cela fonctionne*, j'ai testé sur ton fichier!
C'es bien pour cela que j'ai publié le code.
Mais comme précisé, c'est une idée (donc pas une solution clé en mains)

Par contre que tu n'arrives pas à faire fonctionner mon code, c'est une autre histoire

*: les deux photos présentes sur la feuille photos sont bien copiées dans la feuille destination.
Pour le reste, c'est à développer (...ou pas) au vu du nombre de photos potientiellement contenu dans ton classeur.

Mais JM, les 2 photos de la feuilles destination sont la pour exemple.
Ce que j'ai besoin de copier, ce sont les 10 photos de la feuille "photos" en colonne A de la feuille "destination"

 

[Usine à gaz]

Bonsoir Lionel, Jean Marie, Le Forum

@arthour973

Lionel, tu as un reçu, un coup de marteau ou un coup de cric sur la tête?! Mis à part les msgbox, c'est bien ce que fait la macro que Jean Marie t'as montré.

Bonsoir Lone,
Coup de marteau LOL mais pas assez fort pour "m'estourbir ".
Vois ma réponse à notre ami JM

 

[Usine à gaz]

Je rectifie, effectivement, ça copie bien, je ne partais pas sur la bonne feuille.

Merci JM c'est presque bon.
Je continue à chercher pour que les photos soient copiées dans la colonne A dans chaque cellule en descendant.
C'est déjà une belle avancée

 

[Staple1600]

Re

Un léger mieux avec ceci
(*:ce type de code est présent dans moult posts sur le forum)

Sub test_2()
Dim i&, a$
For i = 1 To ActiveSheet.Shapes.Count
    With ActiveSheet.Shapes(i)
        Select Case .Type
        Case msoPicture
        'juste pour test
        'MsgBox .Name
        'Msgbox .TopLeftCell.Address
        a = .TopLeftCell.Address
        .Copy
        With Sheets("destination").Cells(Rows.Count, 1).End(3)(2)'* le type de syntaxe en question
        .Value = a
        .PasteSpecial
        End With
        End Select
        a = ""
    End With
    Application.CutCopyMode = False
Next
End Sub

 

[Usine à gaz]

Mais JM, c'est plus qu'un léger mieux (je n'avais pas vu ce code).
C'est exactement ça, nickel.
Un grand merci JM
Je vais tenter de comprendre le code.
Amicalement,
arthour973

 

[Lone-wolf]

Re à vous deux

@arthour973

Ou encore comme ceci

Option Explicit

Sub test()
Dim i As Long

Application.ScreenUpdating = False
Feuil7.Activate

With ActiveSheet
For i = 1 To .Shapes.Count
.Shapes(i).Copy
Feuil1.Cells(i + 2, 1).PasteSpecial
Next i
End With
Application.Goto Feuil1.Range("a1")
End Sub

 

[Usine à gaz]

Merci Lone,

Je ne comprends pas les codes (trop technique pour moi ) mais ça marche super aussi
Un grand merci

 

[Staple1600]

Re

@Lone_Wolf
Pour infos
Ton code recopiera toutes les Shapes
( avec le Type : msoPicture)
on ne recopiera que les images
(cf mon code dans les messages#2,#10)

 

[Staple1600]

Re

@arthour973

Merci Lone,
Je ne comprends pas les codes (trop technique pour moi )

Ne te fais pas plus néophyte que tu n'es
Tu as quand même plus de 2000 message au compteur...

Il n'y a rien de technique dans le fait de boucler sur des Shapes
(toutes les lignes de codes présentes dans ce fil (les miennes comme celles de Lone-Wolf) peuplent un grand nombre de fils, qui n'attendent que toi dans les archives du forum