Insertion automatique d'images sous excel

Bonjour,
il faut tout de meme indiquer à Excel ou se trouvent vos images ! c'est pour cela que vous devez creer une colonne avec vos liens
vers ces photos (quelles soient sur votre disque dur ou sur internet (peut importe la colonne que vous choississez, pensez à modifier l'offset en fonction de la colonne choisie)
en colonne A mettez vos Titre , en B vos liens, en C les photos s'affichent (pensez à masquer le colonne B, afin de ne pas visualiser la colonne b)

Re,

Bon, j'ai refait un peu la macro.
Maintenant sélectionner les cellules où sont les liens pointant sur une image.
En répondant à la 1ère boite de dialogue par 'oui', 'non' ou 'annuler' l'image s'affichera dans la colonne à gauche, ou dans celle du lien ou dans celle de droite (en fait bouton de gauche affiche à gauche etc).
Puis la 2nde boite de dialogue permet de choisir la hauteur des ligne (donc des image). La hauteur par défaut (75) peut être changé en début de code en changeant la valeur de la constante hDefaut.

Sub AffImage2()
    ' Sélectionner les cellules contenant un lien vers une image
    ' AffImage les affichera sur le lien ou dans la colonne de gauche ou de droite
    Const hDefaut = 75
    Dim msg As String, r As Long, h As Long
    Dim c As Range
    msg = "Oui : Afficher les images à gauche des liens sélectionnés" & vbCrLf
    msg = msg & "Non : Afficher les images sur les liens sélectionnés" & vbCrLf
    msg = msg & "Annuler : Afficher les images à droite des liens sélectionnés"
    r = MsgBox(msg, vbYesNoCancel, "Cellules où mettre les images")
    If r = vbYes Then
        r = -1
    ElseIf r = vbNo Then
        r = 0
    Else
        r = 1
    End If
    h = InputBox("Hauteur des lignes :", "Choix hauteur", hDefaut)
    For Each c In Selection
        'c.ColumnWidth = 20
        fich = c.Value
        If fich <> "" Then
            c.RowHeight = h 'fixer la hauteur de ligne
            ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue 'conserver les proportion
                .Height = h - 4 'hauteur de l'image = hauteur des lignes - 4
                .Left = c.Offset(0, r).Left + 2 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
                .Top = c.Top + 2 'et positionner verticalement
            End With
        End If
    Next c
End Sub

eric

Bonjour,

Le remercié te remercie :-)
eric

Bonsoir,

J'ai ajouté une gestion d'erreur rudimentaire pour éviter la majorité des blocages, avec la possibilité d'afficher une image par défaut si la constante imgDefaut est renseignée.
Sinon le chamin des images peut être le résultat d'une fontion.
Par exemple tes liens en colonne A, en B tu saisis :
=SI(DROITE(A1,4)<>".jpg",A1&".jpg",A1)
pour rétablir le .jpg de fin

Sub AffImage2()
    ' Sélectionner les cellules contenant un lien vers une image
    ' AffImage les affichera sur le lien ou dans la colonne de gauche ou de droite
    Const hDefaut = 75
    Const imgDefaut = "" ' saisir chemin complet et nom image par défaut à afficher si erreur
    Dim msg As String, r As Long, h As Long
    Dim c As Range, numfich As Integer
    msg = "Oui : Afficher les images à gauche des liens sélectionnés" & vbCrLf
    msg = msg & "Non : Afficher les images sur les liens sélectionnés" & vbCrLf
    msg = msg & "Annuler : Afficher les images à droite des liens sélectionnés"
    r = MsgBox(msg, vbYesNoCancel, "Cellules où mettre les images")
    If r = vbYes Then
        r = -1
    ElseIf r = vbNo Then
        r = 0
    Else
        r = 1
    End If
    h = InputBox("Hauteur des lignes :", "Choix hauteur", hDefaut)
    For Each c In Selection
        'c.ColumnWidth = 20
        fich = c.Value
        ' test fichier
        If fich <> "" Then
            numfich = FreeFile()
            On Error GoTo errfich
            Open fich For Input As #numfich
            Close #numfich
            GoTo suite1
errfich:
            fich = imgDefaut
suite1:
        End If
            '
        If fich <> "" Then
            c.RowHeight = h 'fixer la hauteur de ligne
            ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
            With Selection.ShapeRange
                .LockAspectRatio = msoTrue 'conserver les proportion
                .Height = h - 4 'hauteur de l'image = hauteur des lignes - 4
                .Left = c.Offset(0, r).Left + 2 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
                .Top = c.Top + 2 'et positionner verticalement
            End With
        End If
    Next c
End Sub

eric

Bonjour, je pense que c'est possible avec notamment la fonction activeSheet.Pictures.Insert (chemin du fichier)
ce que je n'arrive pas a faire : c'est indiqué dans chemin du fichier, que le chemin est indiqué dans la cellule B1.

autre probleme quand on insere plusieus activesheet.pictures.insert, les images se superposent sur une meme cellule.

Je rapelle le but de la maneouvre : B1 donne le lien url d une image, en A1 s'affiche l image. et ainsi de suite.

J'ai cherche sur pas mal de forums, mais personne ne semble savoir repondre. Je vais encore chercher ...

Merci à popie1976 pour ses encouragements ....

Bonjour,

Definis déjà une même hauteur pour toutes les lignes ( ici 75)
en B3 le chemin du fichier "C:\Documents and Settings\All Users\Documents\Mes images\Échantillons d'images\Collines.jpg"
(je n'ai pas testé avec un URL)

Sub test()
fich = [B3].Value 'recup nom fichier
ligne = [B3].Row 'en quelle ligne ?
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
ligne = 3
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With
End Sub

si les hauteurs de ligne et largeur de colonne ne sont pas fixes tu peux recuperer leur valeurs pour calculer .top et .left mais c'est plus lourd à gérer

J'espère t'avoir guidé là il fallait
eric

Merci eriiic, je progresse ... cela correspond a ce que je veux faire, mais peut on automatiser tout ca ?

voila ce que j'ai ecrit pour voir s'afficher le resultat de 3 liens : (ci dessous) - on peut certainement eviter de devoir copier coller et manuellement de modifier le champs [B2] ... [B3] .... est ce possible de realiser une boucle ? n liens correspond à n affichages

au fait, cela marche avec une url !!! grand merci !!!

Sub test()
fich = [B1].Value 'recup nom fichier
ligne = [B1].Row 'en quelle ligne ?
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
ligne = 1
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With

fich = [B2].Value 'recup nom fichier
ligne = [B2].Row 'en quelle ligne ?
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
ligne = 2
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With

fich = [B3].Value 'recup nom fichier
ligne = [B3].Row 'en quelle ligne ?
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
ligne = 3
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With

End Sub

Ah ben oui, c'était juste en exemple pour montrer comment placer une image où on veut mais il ne faut pas le copier 823 fois.
(d'ailleurs je viens de voir que ' ligne = 1' est superflu car ensuite j'avais ajouté la récupération du numéro de ligne à partir des references d'une cellule avec 'ligne = [B1].Row ')

tu pourrais faire qcq chose comme ça :

sub machin()
for each c in selection
fich = c.offset(0,1).value
ligne = c.row
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With
next c
end sub

pour l'utiliser tu selectionnes en colonne A toutes les cellules où tu veux mettre l'image dont l'adresse est en colonne B puis tu appelles la macro.
Bon, pas sûr que tout marche car là je ne peux tester
eric

Merci beaucoup !!!
cela fonctionne à merveilles ...

je n'ose pas poussez le bouchon ... mais n'y a t il pas un moyen d'ajuster au mieux les cellules. car au bout d'une 15aine de photos, bien qu'elles soit proporionnées, il y a un decalage du certainement à des approximations ...

en tout cas Eriiic , chapeau bas ... merci encore ...

Bonjour luseve,

peux-tu m'expliquer ce que tu appelles ajuster et comment est ce décalage...
je viens de tester et je n'ai pas ce décalage, sans doute parce que j'utilise tjs la même et encore je ne me l'explique pas
si tu pouvais mettre ton fichier ici via www.cijoint.com ça serait mieux
eric

PS: si tu le désires on peut aussi les centrer horizontalement et regler automatiquement la largeur de la colonne A en fonction de la plus grande ou d'autres trucs si tu as des idées.
eric

une amélioration qui résoudra sans doute ton pb:
remplace .Top = 75 * (ligne - 1) par c.top

si c'est ok tes lignes pourront avoir n'importe quelle hauteur mais il faudra quand même que leur hauteur ne change plus après ajout de photos. Il faudrait une autre petite macro pour adapter leur position sur cet evenement
eric

bonjour!

je souhaiterais inserer des images dans une colonne (par exple une image en C1,une autre en C2, ..., une autre en Cn)
puis-utiliser la formule preconisee, si oui ou et comment l'inserer?

Merci davance

SiwomYel

Bonjour,
il faut creer une macro
et taper ceci :

sub machin()
for each c in selection
fich = c.offset(0,1).value
ligne = c.row
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 72 'hauteur de l'image - un tit qcq chose pour qu'elle soient séparée
.Left = 0 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = 75 * (ligne - 1) 'et positionner verticalement
End With
next c
end sub
merci à eriic, chez moi cela fonctionne !

donner en B1 le chemin ou se trouve la photo , ainsi de suite (...) Bn, puis selectionner B1 à Bn, lancer la macro, les photos s'affichent en A1 (...) An, pour afficher le resultat en C1 (...) Cn il faut modifier .left= la valeur souhaitée correspondant à la position du debut de la colonne C.

C'est tout !

Bonjour tout le monde,

Faites quand même la modif que j'avais préconisé en 8
cad. remplacer .Top = 75 * (ligne - 1) par c.top
(juste avant le end with)

Comme ça on se cale vraiment sur la cellule même si la hauteur des lignes précédente a été modifiée.

eric

merci beaucoup, mais je n'ai jamais creer de macros avant, dc comment ca marche.

concretement, dans le menu Macros, j'ai ouvert Visual basic editor (par hasard) ensuite j'ai creerun nouveau fichier, mais je pense qu'il y a des phrases a changer ou a supprimer car je n'y arrive tjrs pas en recopiant simplement la reponse ke tu m'a donnee.

Donc comment on fait concretement, que dois je ouvrir, recopier supprimer changer...

Desolee pr toutes ces questions mais quand on debute c pas evident!

Encore merci pr vos reponses!

Bonsoir,

Tu fais un clic-droit sur le nom de l'onglet de ta feuille et tu choisis 'Visualiser le code'
Tu colles:

Sub AffImage()
For Each c In Selection
Dim c As Range
fich = c.Offset(0, 1).Value
ligne = c.Row
ActiveSheet.Pictures.Insert(fich).Select 'ouverture image
With Selection.ShapeRange
.LockAspectRatio = msoTrue 'conserver les proportion
.Height = 73 'hauteur de l'image = hauteur des lignes - 2
.Left = 1 'à gauche colonne A (sinon tu calcules avec la largeur de colonne des colonnes
.Top = c.Top + 1 'et positionner verticalement
End With
Next c
End Sub

dans la fenetre de droite.
Tu retournes sur ta feuille, tu saisis le lien d'une image en B1 et tu mets la hauteur de ligne à 75.
Tu sélectionne A1 (destination de l'image), ensuite Alt+F8, tu sélectionnes Feuil1.AffImage et executer.
Ca devrait s'afficher.
Quand j'aurai un peu de temps je reprendrai la macro pour la rendre parametrable plus facilement dans le choix des colonnes.
Actuellement il faut jouer sur le 1 de fich = c.Offset(0, 1).Value

Bon courage
eric

Bonsoir,

Je pense que luseve t'a répondu.
Je vais modifier un peu la macro pour lui donner un peu de souplesse mais ça sera un peu plus tard.
Sinon dans le code précédent je viens de voir qu'il faut inverser ces 2 lignes:
For Each c In Selection
Dim c As Range

donc mettre
Dim c As Range
For Each c In Selection

C'est peut-être ça qui te genait
eric

Bonjour,

hO!!!!!!!!!

MERCI BCP!!!!!!!!!!!!!! CA marche!!!!!!!!!!!!!!!!!!!!!

Cependant j'aurai une derniere petite requete. j'ai 900 image a ajouter, y a t-il une formule ou une technique pour ajouter mes liens automatiquement? c'est a dire sans avoir a cliquer droit, ajouter un hyperlink a chaque fois s'il te plait?

Merci d'avance!

SiWomYel

Bonsoir,

Content que tu aies pu mieux le tester.
Pour ta dernière demande, si ce sont des fichiers sur disque dur tu peux, dans une fenetre DOS, rediriger un DIR dans un fichier texte pour avoir les noms de fichiers (dans le répertoire concerné tu saisis DIR /D >> liste.txt), ou bien il doit y avoir des logiciel sous windows qui te le font.
Tu récupères cette liste dans excel, tu la remets un peu en forme pour avoir tes noms en colonne B par exemple. Tu saisis le chemin en A1 C:\tmp\ par exemple , et tu refabriques tout tes liens avec en C1: =$A$1 & B1 que tu étends vers le bas.
Même si ce ne sont pas des liens hypertextes ce n'est pas un problème, le tout est que l'adresse soit complète pour que ça fonctionne.
Pour des fichiers sur le net il y a peu de chance que tu puisses acceder au répertoire pour pouvoir extraire tous les noms de fichiers sinon le principe serait le même...

Bon courage
eric

Petite question:

Je n'y connais pas grand chose en excel et j'apprend petit a petit en ce moment.

La question est la suivante:

Si je crée un colonne avec toutes les liens vers les photos et que je fais apparaître ces photos dans une celle spécifique de excel (exemple:
Lien en B1 et photo apparaît en A1) comme mentionné dans l'exemple de la macro.

Si par la suite dans mon fichier excelle je prend la cellule D1 et que j'y entre =B1

La photo ce répliquera-t-elle alors dans la cellule D1 ?

Je vais essayer de le faire mais si quelqu'un sait que de cette facon sa ne marchera pas mais qu'il y a une autre facon de le faire laisser le moi savoir !