insérer des images

[bosk1000]

voila, j'ai des carte de membre, mais je voudrais que leur photo (en jpg) s'insere automatiquement lorsque je saisie leur nom et prenom.
mais je n'ai rien trouver qui le permette.
est-ce que quelqu'un a un debut de piste ?

[Philippe JOCHMANS]

Bonjour

Dans une feuille, dans un UserForm ?

Starec

[bosk1000]

dans une feuille, mais si c'est a faire que dans un userform, je peux toujours adapter

[Philippe JOCHMANS]

Re

Quelques pistes dans la Excel en faisant une recherche avec le mot image : http://excel.developpez.com/faq/inde...chercher=image

Starec

[bosk1000]

je viens de regarder
il existe une methode avec gestionimage, ça me donne déjà un debut de piste, mais le probleme est que j'ai 600 photo a gerer et je peux pas les mettre sur une feuille de source comme dans l'exemple.

mon idée est comme j'ai une assiociation (exemple : la photo c001 dans le dossier e:\photo correspond a dupont marcel) est-ce que je peux l'afficher lorsque je saisie dans une cellule "dupont marcel" puisque j'ai un fichier excel ou pour chaque nom de fichier jpg, j'ai le nom et le prenom,

soit sur une page excel ou word, peu importe

[fring]

Bonjour,

A condition que le nom de tes images correspond au nom que tu introduits dans la cellule A1 (par exemple), tu peux essayer ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NomImg As String, Chemin As String, Pos As Range
 
If Target.Count = 1 And Target.Address = "$A$1" Then
    Application.ScreenUpdating = False
    Chemin = "E:\Photo\"
    NomImg = Target.Value & ".jpg"
    Set Pos = Range("B5:E15")
    
    On Error Resume Next
    ActiveSheet.Shapes("MonImage").Delete
    
    On Error Resume Next
    With ActiveSheet.Pictures.Insert(Chemin & NomImg)
        .Name = "MonImage"
        .Left = Pos.Left
        .Top = Pos.Top
        .Height = Pos.Height
        .Width = Pos.Width
    End With
End If
 
Set Pos = Nothing
Application.ScreenUpdating = True
End Sub

Cdlt

[bosk1000]

merci
je teste lundi au bureau

[bosk1000]

excellent
ton code fonctionne a merveille

par contre pour mieux comprendre

peux tu joindre une petite explication de texte car je comprend que des brides, j'aimerai comprendre le fonctionnement pour pouvoir mieux appliquer par la suite dans d'autre cas de figure

[fring]

Revoici le code avec quelques commentaires

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NomImg As String, Chemin As String, Pos As Range
 
'Target = cible = cellule modifiée
If Target.Count = 1 And Target.Address = "$A$1" Then '<-- si la cible est A1 et uniquement A1
    Application.ScreenUpdating = False '<-- désactivation du rafraichissement de l'écran
    Chemin = "E:\Photo\" '<-- répertoire où sont stockées les photos
    NomImg = Target.Value & ".jpg" '<-- nom de la photo = valeur de A1 + extension jpg
    Set Pos = Range("B5:E15") '<-- initialisation d'une variable représentant la plage de cellule B5:E15, l'image sera dimensionnée et positionnée selon cette plage de cellules
    
    On Error Resume Next '<-- si pas d'image à supprimer on passe cette étape
    ActiveSheet.Shapes("MonImage").Delete '<-- suppression de l'image précédemment insérée
    
    On Error Resume Next '<-- si pas d'image, correspondante au nom dans A1, trouvée dans le répertoire on passe cette étape
    With ActiveSheet.Pictures.Insert(Chemin & NomImg) '<-- insertion de l'image selon le chemin et le nom définis ci-dessus
        .Name = "MonImage" '<-- nom de l'image insérée
        .Left = Pos.Left '<-- position horizontale = même position que la plage de cellule B5:E15
        .Top = Pos.Top '<-- position verticale = même position que la plage de cellule B5:E15
        .Height = Pos.Height '<-- hauteur = même hauteur que la plage de cellule B5:E15
        .Width = Pos.Width '<-- largeur = même largeur que la plage de cellule B5:E15
    End With
End If
 
Set Pos = Nothing '<-- libération de la mémoire
Application.ScreenUpdating = True '<-- réactivation du rafraichissement de l'écran
End Sub