insert picture which takes the file name from specified cell

Love101

New Member
Joined
Feb 27, 2018
Messages
2
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



6MXj9e4.png
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
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.
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,270
Messages
6,171,102
Members
452,379
Latest member
IainTru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top