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
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Bonjour toutes et tous
un petit tour sans douche chez Jacques Boisgontier, je l'avais vu quelque part vers le centre m'semble
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
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
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"
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
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