Macro excel pour inserer une image! Fermé

Question

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

christian baret · Accepted Answer

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

Gan-z · Answer

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

Manu Lav · Answer

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

Mike-31 · Answer

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)

Mike-31 · Answer

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)

Bili15 · Answer

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.

Mike-31 · Answer

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)

flint9365 · Answer

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

Mike-31 · Answer

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

Gordon · Answer

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.

Mike-31 · Answer

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.

Macro excel pour inserer une image!

11 réponses

Discussions similaires