VBA Insert Multiple Pictures from folder by Picture Name

[decadence]

Hi, I am trying to Insert an Image via it's image name from a folder where it is stored, Is it possible to do this by Picture name?

The code I have so far Searches for specific text via an input box from a sheet copied in a new workbook, If found then reference the Image name from that sheet and compare it to the image name in a folder. What I am having trouble with is actually getting that picture to be inserted into the new workbook only if the image name is the same as the referenced value. Can someone help with this please?

I would like the Images to be put in column B starting in B3 and have 5 rows spacing between each picture if multiple found

Const ImagePath As String = "C:\Users\Decadence\Desktop\Exported GF Pictures\"
Const GFPath As String = "C:\Users\Decadence\Desktop\GF Numbers 2020.xlsx"
Dim ImageName As String, FileList() As String, xSearch As String
Dim File As Integer, LR As Long
Dim Rng As Range, Fnd As Range, xVal As Range
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet
Sub GFSearch()
'
SearchAgain:
    xSearch = InputBox("Enter Search", "Find GF...")
    If (StrPtr(xSearch) = 0) Then Exit Sub
    If (xSearch = "") Then MsgBox "No Search Criteria!": GoTo SearchAgain
    Workbooks.Add
    Set wb1 = ActiveWorkbook
    Set ws1 = ActiveSheet
    ws1.name = "Search Results - " & xSearch
    For Each sht In wb1.Worksheets
        If sht.name <> wb1.ActiveSheet.name Then
            Application.DisplayAlerts = False
            sht.Delete
            Application.DisplayAlerts = True
        End If
    Next sht
    Set wb2 = Workbooks.Open(GFPath)
    ActiveSheet.Copy After:=wb1.Sheets(wb1.Sheets.Count)
    Set ws2 = ActiveSheet
    ws2.name = "GF List"
    wb2.Close False
    With ws2
    Set Fnd = Cells.Find("GF Description", Range("A1"), xlValues, xlPart, xlByRows, xlNext, False, False)
    If Not Fnd Is Nothing Then
        LR = Range("A" & Rows.Count).End(xlUp).row
        Set Rng = Range(Fnd.Offset(1), Cells(Rows.Count, Fnd.Column).End(xlUp))
        Rng.Offset(-1).AutoFilter Field:=1, Criteria1:="*" & xSearch & "*"
        With Sheets("GF List")
            .AutoFilter.Sort.SortFields.Clear
            .Sort.SortFields.Add key:=Range("C2:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            .Sort.SetRange Range("A2:E" & LR)
            .Sort.Header = xlGuess
            .Sort.MatchCase = False
            .Sort.Orientation = xlTopToBottom
            .Sort.SortMethod = xlPinYin
            .Sort.Apply
        End With
    Else
        MsgBox "Search Not Found", vbCritical
        Exit Sub
    End If
    .Visible = xlSheetHidden
    End With
    ws1.Activate
    ImageName = Dir(ImagePath & "*.*")
    Do While Len(ImageName) > 0
        ReDim Preserve FileList(File)
        FileList(File) = ImageName
        File = File + 1
        ImageName = Dir
    Loop
    For Each xVal In Rng.SpecialCells(xlCellTypeVisible)
        For File = LBound(FileList) To UBound(FileList)
            If xVal.Offset(, -1).Value Like FileList(File) Then
                'Insert Picture in the ActiveWorkbook
                Exit For
            End If
        Next File
    Next xVal
End Sub

 

[yky]

This is the code I use to add pictures to sheet.

I store picture names in cell a abc/def/ghi. Because Windows doesn't allow "/" in file name, the picture name on disk is abc-def-ghi.jpg. That's why I use the Replace function to convert picture name in file to picture name on disk. You may not need it.

Cells.Left and Cells.Top tells Excel which cell the picture goes to. Width and height of -1 would give you the picture in its original size. If you know the exact dimension of the picture you want you can plug in the numbers directly.

Dim P As Object
            Set p = ActiveSheet.Shapes.AddPicture(Filename:=Path_Prefix &  _
                Replace(cell.Value, "/", "-") & ".jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=ActiveSheet.Cells(cell.Row, Picture_Column).Left, _
                Top:=ActiveSheet.Cells(cell.Row, Picture_Column).Top, Width:=-1, Height:=-1)