insert picture which takes the file name from specified cell

[Love101]

Hi! i would like to ask if someone can help me with a simple code..
i looked all examples of VBA code but i didnt find any that helped me
(im new to vba codes so im not very sure how to start it...)


i have a folder with photos
D:\WORK\FOTOS\01.jpg
D:\WORK\FOTOS\02.jpg
D:\WORK\FOTOS\03.jpg

and i have a cell G10 that have the info "FOTO 02"

so i need to insert the picture 02.jpg in the cell B17

if G10 become FOTO 03
i need to insert 03.jpg in the cell B17

 

[Derek Brown]

Does the following link seem like a possible solution?
https://www.youtube.com/watch?v=MzF_5DXhqbs

 

[John_w]

Try this code, which is triggered when cell G10 is changed. Put the code in the worksheet module for the worksheet in question - http://www.contextures.com/xlvba01.html#Worksheet shows how.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim picturesFolder As String
    Dim picShape As Shape
    Dim picNumber As String
    Dim pic As Picture
    
    picturesFolder = "D:\WORK\FOTOS\"
    picturesFolder = Trim(picturesFolder)
    If Right(picturesFolder, 1) <> "\" Then picturesFolder = picturesFolder & "\"
    
    If Target.Address = "$G$10" Then
        With Me
            Set picShape = Get_Picture_Shape(.Range("B17"))
            If Not picShape Is Nothing Then picShape.Delete
            picNumber = Split(.Range("G10").Value, " ")(1)
            Set pic = .Pictures.Insert(picturesFolder & picNumber & ".jpg")
            pic.ShapeRange.Left = .Range("B17").Left
            pic.ShapeRange.Top = .Range("B17").Top
        End With
    End If
    
End Sub


Private Function Get_Picture_Shape(pictureCell As Range) As Shape

    Dim shp As Shape
    
    Set Get_Picture_Shape = Nothing
    For Each shp In pictureCell.Parent.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            If shp.TopLeftCell.Address = pictureCell.Address Then
                Set Get_Picture_Shape = shp
                Exit For
            End If
        End If
    Next

End Function

 

[Love101]

yes!!! that what i needed!
thank you john!