Insérer une image différente a chaque feuille

Bonjour la communauté Excel,

Je vous écris car j'aurais besoin de faire une macro qui insérerai une image choisie dans un dossier et ce pour chaque feuille portant un nom précis.

Concrètement, imaginons que j'ai 30 photos à insérer.

Mon classeur Excel contient plusieurs feuilles dont certaines (qui se suivent et qui porte un nom similaire type : nom1, nom2, nom3...) dans lesquelles je veux insérer une photo.

La photo à insérer est différente pour chaque feuille.

En somme, comment dire à Excel d'aller piocher "photo1.jpg" dans dossier situé C:\blabla et l'insérer cellule XX:YY dans feuille "nom1" puis "photo2.jpg" situé dans C:\blabla à la cellule XX:YY dans feuille "nom2" etc... etc... ?

J'ai peur de ne pas être très clair je reste donc à l'écoute pour mieux préciser mes besoins.

(Et promit je me lance dans le VBA très rapidement pour vous aider à mon tour )

Merci d'avance

Bonjour toutes et tous

un petit tour sans douche chez Jacques Boisgontier, je l'avais vu quelque part vers le centre m'semble

ici

et bien entendu remerciement à Jacques Boisgontier d'avance

en espérant que vous trouverez ce dont vous chercher

crdlt,

André

Merci!

J'ai fouillé et j'ai trouvé ça:

"ImportImage", c'est le nom de la macro proposée sur le site Jacques (Je ne peux pas poster le code parce-que je n'ai pas encore 10 posts derrière moi)

Ca permet d'importer mes images, il suffirait juste que j'insère une fonction qui fait passer la feuille active (activesheet?) à la suivante.

Est-ce qu'il existe une méthode ou une fonction prédéfinie pour faire cela?

Voilà où j'en suis de ma macro... Ca fonctionne mais très vite ça me renvoie une erreur à la ligne "ActiveCell*point*Offset..."

Sub PhotoOnglet()
Dim Feuille As Worksheet
Dim i As Integer
'On importe la photo
ActiveSheet.DrawingObjects.Delete
  répertoirePhoto = "c:\MT\"
  nf = Dir(répertoirePhoto & "*.jpg") ' premier fichier
  Range("b2").Select
  Do While nf <> ""
    For i = 1 To Worksheets.Count
      'On vérifie que le nom de l'onglet possede au moins une occurence de "MT"
      If InStr(Worksheets(i).Name, "MT") > 0 Then
      'Si Oui on active la page
      Worksheets(i).Activate
      Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & nf)
      img*point*Top = ActiveCellTop
      img*point*Left = ActiveCellLeft
      imgName = Left(nf, Len(nf) - 4) ' Donne un nom à l'image
      ActiveCellOffset(0, -1) = Application.Proper(Left(nf, Len(nf) - 4))
      ActiveCellEntireRowRowHeight = imgHeight + 2
      nf = Dir ' suivant
      ActiveCellOffset(1, 0).Select
      End If
    Next i
  Loop

End Sub

Bonjour toutes et tous

@Pem83

ou se trouve ce code sur quel site ? je ne le vois pas ?

Edit : Est-ce une modification que vous avez apporter de celui-ci téléchargeable sur le site de Jacques Boisgontier :

ImportPhotos

Sub PhotoOnglet()
Dim Feuille As Worksheet
Dim i As Integer
'On importe la photo
ActiveSheet.DrawingObjects.Delete
  répertoirePhoto = "c:\MT\"
  nf = Dir(répertoirePhoto & "*.jpg") ' premier fichier
  Range("b2").Select
  Do While nf <> ""
    For i = 1 To Worksheets.Count
      'On vérifie que le nom de l'onglet possede au moins une occurence de "MT"
      If InStr(Worksheets(i).Name, "MT") > 0 Then
      'Si Oui on active la page
      Worksheets(i).Activate
      Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & nf)
      img*point*Top = ActiveCellTop
      img*point*Left = ActiveCellLeft
      imgName = Left(nf, Len(nf) - 4) ' Donne un nom à l'image
      ActiveCellOffset(0, -1) = Application.Proper(Left(nf, Len(nf) - 4))
      ActiveCellEntireRowRowHeight = imgHeight + 2
      nf = Dir ' suivant
      ActiveCellOffset(1, 0).Select
      End If
    Next i
  Loop

End Sub

en attente...

Merci pour votre intérêt

Effectivement c'est un mélange d'ImportPhoto et d'un autre bout de script trouvé ailleurs. Je bricole en somme...

J'en suis rendu à ça :

Sub PhotoOnglet()
Dim Feuille As Worksheet
Dim i As Integer
'Pour remplace la boucle for each on compte le nombre d'onglet et on vérifie la difference a chaque boucle
'On importe la photo
ActiveSheet.DrawingObjects.Delete
  répertoirePhoto = "c:\MT\"
  nf = Dir(répertoirePhoto & "*.jpg") ' premier fichier
  Range("F41").Select
  Do While nf <> ""
    For i = 1 To Worksheets.Count
      'On vérifie que le nom de l'onglet possede au moins une occurence de "MT"
      If InStr(Worksheets(i).Name, "MT") > 0 Then
      'Si Oui on active la page
      Worksheets(i).Activate
      Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & nf)
      img*point*Top = ActiveCell*point*Top
      img*point*Left = ActiveCell*point*Left
      nf = Dir ' suivant
      End If
    Next i
  Loop

End Sub

Seulement il y a trois problèmes:

1) Les photos ne s'insèrent pas dans le bon onglet.:

La photo "001.jpg" ne s'insère pas dans l'onglet "MT 1" et ainsi de suite, c'est archaïque.

2) Je ne sais pas comment faire pour l'insérer dans la cellule voulue (qui est une cellule fusionnée qui "commence" en F41)

3) Au bout d'un nombre aléatoire d'insertion le script bug à la ligne "nf = Dir ' suivant"

Re,

oupss non

Edit : les images s'insèrent

Merci, c'est bon j'ai trouvé, à force de bidouillage, ce qui me convenait.

Sub PhotoOnglet()
Dim Feuille As Worksheet
Dim i As Integer
'Pour remplace la boucle for each on compte le nombre d'onglet et on vérifie la difference a chaque boucle
'On importe la photo
ActiveSheet.DrawingObjects.Delete
  répertoirePhoto = "c:\MT\"
  nf = Dir(répertoirePhoto & "*.jpg") ' premier fichier
  Do While nf <> ""
    For i = 24 To Worksheets.Count
      'On vérifie que le nom de l'onglet possede au moins une occurence de "MT"
      If InStr(Worksheets(i).Name, "MT") > 0 Then
      'Si Oui on active la page
      Worksheets(i).Activate
      Range("R43").Select
      Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & nf)
      Set c = img
      ' ajuster hauteur
      img*point*Height = c.Height - 2
      img*point*Top = c*point*Top + 1
      ' centrer
      img.Left = c*point*Left + (c*point*Width - img.Width) / 2
      nf = Dir ' suivant
      End If
    Next i
  Loop
End Sub
Rechercher des sujets similaires à "inserer image differente chaque feuille"