Embora minha recomendação seja aproveitar a automação disponível no Doality.com, especificamente o Picture Manager for Excel
O código vba a seguir deve atender aos seus critérios. Boa sorte!
Adicione um controle de botão à sua pasta de trabalho do Excel e clique duas vezes no botão para acessar o código VBA ->
Sub Button1_Click()
Dim filePathCell As Range
Dim imageLocationCell As Range
Dim filePath As String
Set filePathCell = Application.InputBox(Prompt:= _
"Please select the cell that contains the reference path to your image file", _
Title:="Specify File Path", Type:=8)
Set imageLocationCell = Application.InputBox(Prompt:= _
"Please select the cell where you would like your image to be inserted.", _
Title:="Image Cell", Type:=8)
If filePathCell Is Nothing Then
MsgBox ("Please make a selection for file path")
Exit Sub
Else
If filePathCell.Cells.Count > 1 Then
MsgBox ("Please select only a single cell that contains the file location")
Exit Sub
Else
filePath = Cells(filePathCell.Row, filePathCell.Column).Value
End If
End If
If imageLocationCell Is Nothing Then
MsgBox ("Please make a selection for image location")
Exit Sub
Else
If imageLocationCell.Cells.Count > 1 Then
MsgBox ("Please select only a single cell where you want the image to be populated")
Exit Sub
Else
InsertPic filePath, imageLocationCell
Exit Sub
End If
End If
End Sub
Em seguida, crie seu método de inserção da seguinte maneira:
Private Sub InsertPic(filePath As String, ByVal insertCell As Range)
Dim xlShapes As Shapes
Dim xlPic As Shape
Dim xlWorksheet As Worksheet
If IsEmpty(filePath) Or Len(Dir(filePath)) = 0 Then
MsgBox ("File Path invalid")
Exit Sub
End If
Set xlWorksheet = ActiveSheet
Set xlPic = xlWorksheet.Shapes.AddPicture(filePath, msoFalse, msoCTrue, insertCell.top, insertCell.left, insertCell.width, insertCell.height)
xlPic.LockAspectRatio = msoCTrue
End Sub