Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Chercher une image dans mes documents en fonction de son nom

Hugues Barlet

XLDnaute Nouveau
Bonjour à tous!

Je voulais savoir si il était possible de charger une image dans Excel en fonction du nom dans le fichier excel.
Par exemple, si je tape tomate.png dans la colonne A dans excel, il va me chercher automatiquement (comme un index equiv) l'image tomate.png dans Mes images (sur mon ordinateur) et me l'afficher dans une colonne B par exemple!

Merci pour vos réponses et votre temps !
 

job75

XLDnaute Barbatruc
Bonjour Hugues Barlet,

Téléchargez le fichier et le dossier zippés joints dans le même répertoire (le bureau).

Ces macros évènementielles sont dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Address <> "$B$3" Then Exit Sub
Dim chemin$, fichier$, n&, a$()
chemin = ThisWorkbook.Path & "\Mes images\" 'dossier à adapter
fichier = Dir(chemin & "*.png") '1er fichier du dossier
While fichier <> ""
    ReDim Preserve a(n)
    a(n) = fichier
    n = n + 1
    fichier = Dir 'fichier suivant
Wend
'---liste de validation---
ActiveCell.Validation.Delete
With Sheets("Liste")
    .[A:A].Delete 'RAZ
    If n Then
        .[A1].Resize(n) = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
        .[A1].Resize(n).Name = "Liste"
        ActiveCell.Validation.Add xlValidateList, Formula1:="=Liste"
    End If
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3]) Is Nothing Then Exit Sub
Dim chemin$
[B3].Select
chemin = ThisWorkbook.Path & "\Mes images\" 'dossier à adapter
DrawingObjects.Delete 'RAZ
If ActiveCell <> "" Then
    On Error Resume Next 'si l'image n'est pas trouvée
    With Pictures.Insert(chemin & ActiveCell)
        .Left = ActiveCell.Left
        .Top = ActiveCell(2).Top
    End With
End If
Application.ScreenUpdating = False
ActiveCell(2).Select: ActiveCell(0).Select 'pour mise à jour éventuelle de la liste
End Sub
Edit : ajouté la mise à jour éventuelle de la liste

A+
 

Pièces jointes

  • Image(1).zip
    707.4 KB · Affichages: 8
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Hugues Barlet, le forum,

Autre solution dans ce fichier (2) avec une ComboBox :
VB:
Dim chemin$, flag As Boolean 'mémorise les variables

Private Sub ComboBox1_GotFocus()
Dim fichier$, n&, a$()
chemin = ThisWorkbook.Path & "\Mes images\" 'dossier à adapter
fichier = Dir(chemin & "*.png") '1er fichier du dossier
While fichier <> ""
    ReDim Preserve a(n)
    a(n) = fichier
    n = n + 1
    fichier = Dir 'fichier suivant
Wend
If n Then ComboBox1.List = a Else ComboBox1.Clear
If Not flag Then ComboBox1.DropDown 'déroule la liste
End Sub

Private Sub Combobox1_Change()
If DrawingObjects.Count > 1 Then DrawingObjects(2).Delete 'RAZ
If ComboBox1.ListIndex > -1 Then
    On Error Resume Next 'si l'image n'est pas trouvée
    With Pictures.Insert(chemin & ComboBox1)
        .Left = [B4].Left
        .Top = [B4].Top
    End With
End If
flag = True 'évite de dérouler la liste
ActiveCell.Activate: ComboBox1.Activate 'pour mise à jour éventuelle de la liste
flag = False
End Sub
Bonne journée.
 

Pièces jointes

  • Image(2).zip
    709.6 KB · Affichages: 6

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…