Hi I have created a code that can insert an image to excel but unfortunately image inserted as link to the image file to the local directory. Below is the complete code and the line that Im stuck is
    With rngLogo
    Set pic = .Parent.Pictures.Insert(sFileToOpen)
    pic.Top = .Top + 2.5 ' Customize const (2.5) as you need
    'pic.Left = .Left
    pic.ShapeRange.LockAspectRatio = msoTrue
    pic.ShapeRange.Width = w
    pic.ShapeRange.Rotation = 0#
    pic.Locked = False
And the complete code is

Sub InsertOfficePic()
' Your Procedure modified
'--
Dim rngLogo As Range
Dim sFileToOpen
Dim pic As Object
Dim w, h As Long
Dim sngScale As Single
Dim MyPath As String, MyScript As String, MyFiles As String
'Const csSHEET_NAME As String = "Open House Sheet"
'Const csRANGE_NAME As String = "OfficeLogo"

''''''MAC''''''''


#If Mac Then
    'Get the documents folder as a default
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")

    'Set up the Apple Script to look for text files
    MyScript = "set applescript's text item delimiters to "","" " & vbNewLine & _
            "set theFiles to (choose file of type " & " {""public.png"", ""public.jpg"", ""public.jpeg""} " & _
            "with prompt ""Please select a file or files"" default location alias """ & _
            MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
            "set applescript's text item delimiters to """" " & vbNewLine & _
            "return theFiles"

    'Run the Apple Script
    sFileToOpen = MacScript(MyScript)
    On Error GoTo 0

    'If there are multiple files, split it into an array and return the results
  If sFileToOpen = False Then Exit Sub







'''''MAC''''




#Else


sFileToOpen = Application.GetOpenFilename( _
"Picture Files,*.jpg;*.jpeg;*.bmp;*.png;*.tif;*.gif", _
Title:="Please select a Logo.")
If sFileToOpen = False Then Exit Sub

#End If
For Each ws In ThisWorkbook.Worksheets
 If ws.Name = "Real Audience pie chart" Then
GoTo 10
End If

With ThisWorkbook.Worksheets(ws.Name)
.Activate ' optional
'Reference Picture Range
If ws.Name = "ROI Summary" Then
Set rngLogo = .Range("B4:J4")
Else
If ws.Name = "Intake Session" Then
Set rngLogo = .Range("B4:I4")
Else
If ws.Name = "Major GrowthMAP Session" Then
Set rngLogo = .Range("B4:I5")
Else
If ws.Name = "Closing Session" Then
Set rngLogo = .Range("B4:I5")
Else
If ws.Name = "Profit Analysis" Then
Set rngLogo = .Range("B4:H4")
End If
End If
End If
End If
End If


' Delete all previous pictures
For Each pic In .Pictures
'Here you can put deleting criteria, e.g.
'If pic.Name <>"YourPicture" Then
pic.Delete
Next pic

With rngLogo ' Is this Range Name = "OfficeLogo"?
h = .Height
w = .Width
End With



With rngLogo
Set pic = .Parent.Pictures.Insert(sFileToOpen)

pic.Top = .Top + 2.5 ' Customize const (2.5) as you need
'pic.Left = .Left

pic.ShapeRange.LockAspectRatio = msoTrue
pic.ShapeRange.Width = w
pic.ShapeRange.Rotation = 0#
pic.Locked = False

pic.Placement = xlFreeFloating
On Error Resume Next
' adjust Logo dimensions
If pic.Width < w And pic.Height < h Then
sngScale = 1.001
Do Until pic.Width >= w Or pic.Height >= h
pic.ShapeRange.ScaleWidth sngScale, msoFalse
pic.ShapeRange.ScaleHeight sngScale, msoFalse
sngScale = sngScale + 0.01
Loop
Else
sngScale = 0.999
Do Until pic.Width <= w And pic.Height <= h
pic.ShapeRange.ScaleWidth sngScale, msoFalse
pic.ShapeRange.ScaleHeight sngScale, msoFalse
sngScale = sngScale - 0.01
Loop
End If

pic.Left = rngLogo.Left + (w - pic.Width) / 2 + 1

End With
'pic.PrintObject = True
End With
10
Next
MsgBox "Logo Changed"
ThisWorkbook.Sheets(1).Activate
End Sub