Bon, je confirme, avec quelques arrangements mineurs, la première macro fonctionne très bien. Il faut changer trois petites choses dans le code, et modifier le nom des images.
Pour le code, l'idée, c'est de s'assurer d'avoir le bon séparateur dans le chemin d'accès. Donc je rajoute deux lignes :
Dim PathSep As String ' dans les déclarations de variables
PathSep = Application.PathSeparator ' pour pouvoir utiliser le séparateur adapté à la version d'Excel
Ensuite, j'ai modifié la ligne qui permet de récupérer l'image ensuite (pour faire simple, j'ai supprimé le sous-dossier "Trains" mais ça aurait pu être conservé) :
Image = ThisWorkbook.Path &
PathSep & .Cells(Lg, "B")
En fait, c'est parce que j'ai constaté que, une fois l'archive dézippée, ce qui devait être un sous dossier "Trains" s'est transformé en modification du nom des images. Donc "Essai_1.jpg" devient "Trains\Essai_1.jpg", pas utilisable tel quel (surtout sur un Mac).
Une fois ces modifications faites, la macro marche comme prévu, un clic sur le bouton et hop !
Ci-dessous, la macro "Affiche_Image" revue (mais il faut conserver "Efface_Image" telle quelle, bien entendu) :
Bloc de code:
Sub Affiche_Image()
Dim Ws As Worksheet ' Sert à manipuler plus facilement l'objet feuille
Dim Image As String ' Contiendra le nom de l'image
Dim Lg As Long ' Numéro de la dernière ligne colonne B
Dim PathSep As String ' ajouté
Set Ws = Sheets("Feuil1") ' Nom de la feuille
Application.ScreenUpdating = False ' Interdit le raffraîchissement d'écran
PathSep = Application.PathSeparator ' ajouté
Efface_Images
With Ws
For Lg = 1 To .Range("B65536").End(xlUp).Row ' Parcourt de toute la colonne B
Image = ThisWorkbook.Path & PathSep & .Cells(Lg, "B") ' Répertoire à actualiser ' modifié
On Error Resume Next ' On s'affranchit des erreurs
With .Pictures.Insert(Image).ShapeRange ' On insère l'image dont le nom est en colonne B
.LockAspectRatio = msoFalse ' On peut la redimmensionner comme on veut
.Left = Ws.Cells(Lg, "A").Left ' Position gauche
.Top = Ws.Cells(Lg, "A").Top ' Position Haut
.Width = Ws.Cells(Lg, "A").Width ' Largeur
.Height = Ws.Cells(Lg, "A").Height ' hauteur
End With
If Err.Number > 0 Then ' Si une erreur (image non présente)
MsgBox .Cells(Lg, "B") & vbCr & "Image inexistante" ' On le signale
End If
Next Lg
End With
End Sub
A partir de là, ça devrait facilement s'adapter à ton cas de figure...
[MàJ] :
On pourrait toutefois parfaitement conserver le principe d'un sous dossier "Trains" (pour rester dans l'exemple) à condition d'écrire dans la macro cette ligne un peu différemment :
Image = ThisWorkbook.Path & PathSep & "Trains" & PathSep & .Cells(Lg, "B")
et de placer les images dans un sous-dossier "Trains" (mais il faudra quand même intervenir sur le nom des images).
