Need help in vb macro to insert picture with cell reference

[Ateeb Ali]

Dear - I need one help, using following code

Dim fNameAndPath As Variant
Dim pRng As Range
Dim pTop As Long, pLeft As Long, pHeight As Long, pWidth As Long

fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub

Set pRng = ActiveSheet.Range("S27")

With pRng.MergeArea
    pTop = .Top
    pLeft = .Left
    pHeight = .Height
    pWidth = .Width
End With

ActiveSheet.Pictures.Insert(fNameAndPath).Select

With Selection.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = pLeft
    .Top = pTop
    .Width = pWidth
    .Height = pHeight
End With

With Selection
    .Placement = xlMoveAndSize
    .PrintObject = True
End With

I just need one amendment to show only those pictures in drive match with cell reference: "D7"

 

[Ateeb Ali]

sir, its not working.
let me also add the values in "D7" appears from following formula
=PROPER('New Style'!F18)

and final result is like this "315733-Sp24-3X12- (Soboor ) "
So when we click insert image button which I linked with your following code;
Only those image should appear which file name as "315733-Sp24-3X12- (Soboor ) .jpg)

Sub GetPic()
ActiveSheet.Unprotect "a"

Dim fNameAndPath As Variant
Dim pRng As Range
Dim pTop As Long, pLeft As Long, pHeight As Long, pWidth As Long

fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub

Set pRng = ActiveSheet.Range("S27")

With pRng.MergeArea
    pTop = .Top
    pLeft = .Left
    pHeight = .Height
    pWidth = .Width
End With

If ActiveCell.Address = "$D$7" Then
    ActiveSheet.Pictures.Insert(fNameAndPath).Select
    With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Left = pLeft
        .Top = pTop
        .Width = pWidth
        .Height = pHeight
    End With
    With Selection
        .Placement = xlMoveAndSize
        .PrintObject = True
    End With
End If
ActiveSheet.Protect "a"

End Sub

 

[Ateeb Ali]

thanks a lot., it works fine
stay blessed