Macro excel pour inserer une image!

[Fermé]
Signaler
Messages postés
4
Date d'inscription
jeudi 8 février 2007
Statut
Membre
Dernière intervention
29 octobre 2008
-
Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
-
Bonjour,

Novice de la macro, je cherche à crée un fichier excel.
Je souhaiterai crée une macro permettant de récuperer une image dans une banque de donnée image (situé en feuil 2 par exemple) grâce à un n° de lot.
Je souhaiterai l'inserer dans un tableau situé en feuil 1 dans un tableau prévu à cet effet ( dans la cellule F2 de feuil 1 par exemple)

Si possible, il pourrai etre interessant de mettre la photo inséré à un format identique pour toute les references.

La question c'est est ce qu'une macro peut redimmensionner une image?

Sinon, si c'est trop compliqué ou chiant à faire je peux les redimensionner avant avec PSP.

Jéspere que quelqu'un va pouvoir m'aider
Merci d'avance

LG

11 réponses


J'ai eu pour ma fille à réaliser un travail similaire
Elle disposait d'une collection de photos dont le nom commençait toujours par une clef (radical) calculé par rapport à des informations présente sur la ligne sélectionnée

Cette collection de photo était présente dans un dossier nommé photos inclus dans le dossier contenant le fichier excel
1er à l'ouverture de la feuille excel, on récupére le dossier du fichier excel pour pouvoir localiser les photos en remplissant une cellule d'un onglet caché baptisé Fichier
Private Sub Workbook_Open()
Sheets("Fichier").Cells(1, 2).Value = Application.ActiveWorkbook.Path + "\photos"
End Sub

Dans la macro principale je dresse la liste des images à afficher dans un tableau Fichier$
Call fabdirectory(radical$)
ReDim Fichier$(20)
J = 1
r$ = Sheets("Fichier").Cells(1, 2).Value
While Sheets("Fichier").Cells(J, 1).Value <> ""
fmax = fmax + 1
Fichier$(fmax) = r$ + "\" + Sheets("Fichier").Cells(J, 1).Value
J = J + 1
Wend
Ensuite je lance l'affichage des images dans un autre onglet Baptisé Fiche et contenant aussi des informations textuelle
Call ChangeImage(Fichier$(), fmax)



Voici le code de la macro fabdirectory

Sub fabdirectory(radical$)
' Renvoie le nom des fichiers image du dossier photos correspondant au radical
repertoire$ = Sheets("Fichier").Cells(1, 2).Value + "\" + radical$ + "*.*"
Sheets("Fichier").Columns("A:A").ClearContents
Myfile = Dir(repertoire$)
While Myfile <> ""
Term$ = Right$(LCase$(Myfile), 4)
If (Term$ = ".jpg") Or (Term$ = ".gif") Or (Term$ = "jpeg") Or (Term$ = ".bmp") Then
k = k + 1
Sheets("Fichier").Cells(k, 1).Value = Myfile
End If
Myfile = Dir
Wend
End Sub

Voici la macro Afficheimage dans l'onglet fiche. A noter que je commence par retirer toutes les images présentes dans cet onglet puis je réinsére toutes les images trouvées dans la recherche précédente les unes en dessous des autres et je les redimensionne une à une pour qu'elles aient toutes une taille homogéne

Sub ChangeImage(Fichier$(), fmax)
Dim objFeuille As Worksheet, objPict(20) As Picture
Sheets("Fiche").Select
' Effacement eventuel des images de l'affichage précédent
On Error Resume Next
For i = 1 To 20
nom$ = "Image" + Trim$(Str$(i))
ActiveSheet.Shapes(nom$).Delete
Next i
On Error GoTo 0
Set objFeuille = Sheets("Fiche")
For i = 1 To fmax
F$ = Fichier$(i)
'Ajout de l'image
Set objPict(i) = objFeuille.Pictures.Insert(F$)
'Determination d'un coeficient de réduction d'image
Largeur = objPict(i).Width
Hauteur = objPict(i).Height
Kh = 300 / Hauteur
Kl = 300 / Largeur
If Kl > Kh Then
k = Kh
Else
k = Kl
End If
' Positionnement et redimentionnement
With objPict(i)
.Name = "Image" + Trim$(Str$(i))
.Left = Range("D4").Left
.Top = Range("D4").Top + Decallage
.ShapeRange.ScaleWidth k, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight k, msoFalse, msoScaleFromTopLeft
End With
' Determination de la position suivante
Decallage = objPict(i).Top + objPict(i).Height + 2
Next i
End Sub
7
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 42674 internautes nous ont dit merci ce mois-ci

Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
4 727
Salut,

Tu n'as pas besoin de VBA, regardes le fichier avec ce lien et on en reparle

https://www.cjoint.com/?iqvxh3uoN4

Maintenant si tu tiens au VBA, j'ai donné deux codes Post 5 et 7 dans la discussion ci-dessous

https://forums.commentcamarche.net/forum/affich-13865122-insertion-d-image-dans-excel#7

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)
Messages postés
10
Date d'inscription
samedi 5 juillet 2008
Statut
Membre
Dernière intervention
16 août 2009
2
Un tout grand merci à toi, j'ai appliqué sans VBA comme tu me l'avais conseillé.

A+
Messages postés
108
Date d'inscription
lundi 14 janvier 2008
Statut
Membre
Dernière intervention
1 mai 2018
24
Bonjour,

J'aimerai inserer des images dans un document Excel.
Les images sont stockées dans un répertoire dédiés. Les images sont en .JPG
En saisissant le nom de l'image dans une cellule et après avoir executer une macro, j'aimerai que l'image
apparaisse la où je le souhaite.

En admettant qu'il n'y ait pas de texte, il faudrait qu'un message apparaisse afin de prévenir qu'il n'y pas d'image disponible.

Pouvez vous m'aider à consituer cette macro ?
Merci d'avance.
Nicolas
Bonjour,

J'aimerai inserer des images dans un document Excel.
Les images sont stockées dans un répertoire dédiés. Les images sont en .JPG
En saisissant le nom de l'image dans une cellule et après avoir executer une macro, j'aimerai que l'image
apparaisse la où je le souhaite.

En admettant qu'il n'y ait pas de texte, il faudrait qu'un message apparaisse afin de prévenir qu'il n'y pas d'image disponible.

Pouvez vous m'aider à consituer cette macro ?
Merci d'avance.
Nicolas

Bonjour,

J'ai aujourd'hui le même problème, as-tu eu une réponse à ta question du mois de mai?

Merci d'avance,
Loïc
Messages postés
108
Date d'inscription
lundi 14 janvier 2008
Statut
Membre
Dernière intervention
1 mai 2018
24 > lo
Salut Loic,

Je te donne une macro pour inserer tes images en JPEG:


Sub Insère_image_de_la_référence()
Dim MonImage As String 'insère l'image de la référence concernée

MonImage = Range("L7").Value 'Cellule ou l'on tape le nom de l'image qui va apparaître en cellule "C3"
Range("C3").Select
On Error Resume Next 'Si il n'ya pas d'image dans le dossier la macro s'arrête sans message d'erreur.
ActiveSheet.Pictures.Insert("adresse dossier ou se trouve l'image" & MonImage & ".jpg").Select
End Sub

Pour supprimer toutes les images du classeur :

Sub Supprime_toutes_images_de_l_onglet_fiche_suiveuse()

ActiveSheet.Unprotect
Sheets("Nom de l'onglet").Pictures.Delete 'Supprime les images dans l'onglet "Nom de l'onglet"

End Sub

En esperant avoir repondu a ta question,
Cordialement,
Nicolas
Messages postés
10
Date d'inscription
samedi 5 juillet 2008
Statut
Membre
Dernière intervention
16 août 2009
2
Bonjour,

Etant novice dans le VBA, je demande conseil et même grande aide...

J'aimerais qu'un logo apparaisse en fonction du nom choisi dans ma liste déroulante.

J'ai enregistré les logos sur la même feuille et indiqué les noms correspondants dans les cases proches.

Merci d'avance
Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
4 727
Re,

Si tu as besoin d'explications, n'hésites pas.

J'en profite pour faire une mise au point sur des discussions que j'ai lu sur les forums, contrairement aux idées reçues il est possible de créer une liste de photos dans les cellules et d'appliquer les filtres trie croissant et décroissant

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)
Bonjour,

je n'arrive pas à faire cette manipulation (image + tri), auriez-vous un lien où je pourrais la trouver ?

rick
Bijour

Je suis entrain de créer toute une suite de formulaires excel pour plusieurs personnes qui disposent chaqunes de leur propre logo.

J'aurais besoin d'une formule dans excel qui puisse insérer automatiquement, à l'ouverture du document, le logo alligné en haut à droite en allant le chercher dans un répertoire donné.

Je n'arrive pas à adapté les formules ci-dessus à mon cas de figure sachant que je n'utilise jamais de macro et encore moin les scripts sur VB. Je n'ai donc aucune idée de domment les utilisé même si je sais comment lancé vb par excel...

Pouvez-vous me donner un petit explicatif de votre solution ainsi que le cheminemant de son utilisation ?

Un grand merci d'avance pour vos réponses.
Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
4 727
Salut Bili,

Ouvres ta propre discussion, ce sera plus facile à gérer et ton problème est totalement différent de celui ci.

Joint un modèle de ton fichier que nous comprenions facilement tes besoins avec ce lien

https://www.cjoint.com/

Lorsque tu auras ouvert ta discussion tu peux me faire signe avec un petit message privé en cliquant sur mon pseudo et message privé

A+
Mike-31

Un problème sans solution est un problème mal posé  (Einstein)
Bonjour. Je suis à la recherche d'une petite macro me permettant d'inserer une image dans une cellule.
Je dispose d'un fichier (base de données image) contenant des images .jpg.
Je voudrais que la macro insère l'image qui est nommée comme ce que j'aurais mis dans la cellule.
En gros j'ai 400 noms de pièces, et 400 photos à insérer dans leurs fiches respectives.
Si quelqu'un peut m'aider. Merci
Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
4 727
Salut,

Tu aurais dû ouvrir ta propre discussion pour avoir le maximum de réponses, regardes sur ce lien un exemple voir si c'est que tu cherches faire,

https://www.cjoint.com/?luvHg8jX6t
Bonjour Gan-z,

C'est exactement le code que je cherchais. Je viens de l'insérer à mon fichier, j'ai lancé la macro mais aucune image n'est insérée.

Pouvez-vous me dire où sont les erreurs, voici mon code modifié :

Sub TraitementImg()
'myDearFriend! - www.mdf-xlpages.com
Dim Emplacement As Range
Dim Fichier As String
Dim i As Byte

On Error GoTo Fin
For i = 1 To 2
Set Emplacement = Range(Choose(i, "C7:C9", "C11:F13", "C15:C17", "C20:C22", "C24:C26", "C28:C30", "C32:C34", "C36:C38", "C40:C42", "C44:C46", "C55:C57", "C59:C61", "C63:C65", "C68:C70", "C72:C74", "C76:C78", "C80:C82", "C84:C86", "C88:C90", "C92:C94", "C99:C101", "C104:C106", "C108:C110", "C112:C114", "C116:C118", "C120:C122", "C124:C126"))
Fichier = "Figure" & CStr(i)

With ActiveSheet.Pictures.Insert("F:\Documents\dl datas\Vidéothèque\Affiches de film" & Fichier & ".JPG").ShapeRange
.Name = "cible" & CStr(i)
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With
Next i

Exit Sub
Fin:
MsgBox "Insertion d'image interrompue."
End Sub


Merci d'avance de votre feed-back.
Messages postés
17537
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
17 septembre 2021
4 727
Salut Rick,

Ouvre ta propre discussion, celle ci est ancienne.
Une fois ouverte fais moi signe avec un message privé afin que je te fasse un fichier exemple (clic sur mon speudo et message privé)
L'intérêt d'un forum est que les discussions profitent à tous.