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

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

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