Insert Image Macro

[Brandon212]

New member here!

I have just recently started playing with macros and I have setup a work doc that runs a macro when a button is pushed. This macro allows me to browse for an image and then inserts it into a range of cells, resizes and centers it. The problem I am having is the image is linked to the original file. Is there a way to break the link or try another approach that doesn't keep this link?

Things I really need:

1. Browse to select a file.
2. Resize and center in cells.
3. No link to original file.

This is what I am using right now:

Sub INSERT_PICTURE_HORIZONTAL()
Dim picToOpen As String
picToOpen = Application _
.GetOpenFilename("")
If picToOpen <> "" Then _
InsertPictureInRange picToOpen, Range(Cells(5, 2), Cells(29, 13))


End Sub


Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double, r As Integer
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Width
h = .Height
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With


' position picture
With p
If .Width > w Then
.Width = w
.Height = h
End If
.Top = t + (h - .Height) / 2
.Left = l + (w - .Width) / 2
End With


Set p = Nothing


End Sub

 

[Ron Coderre]

I have this VBA code in my "stash" that places an un-linked image in a cell...
The below code
• loops through each cell in the selected range
• reads the filepath from that cell
• inserts the referenced picture in the cell to the right of the cell:
• resizes the height and width of the picture to the cell's height

Sub InsertPicFromFile()
Dim cCell As Range
For Each cCell In Selection
    If cCell.Value <> "" Then
        On Error Resume Next
        ActiveSheet.Shapes.AddPicture _
            Filename:=cCell.Value, LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, _
            Left:=cCell.Offset(ColumnOffset:=1).Left, Top:=cCell.Top, _
            Width:=cCell.Height, Height:=cCell.Height
    End If
Next cCell
End Sub

Is that something you can work with?

 

[Brandon212]

Wow, thanks for the quick response!

I wasn't able to get your piece of code to work but I am playing around with something much simpler than before and it does everything but position and size the image. Can you help with how to center and size it for Range(Cells(5, 2), Cells(29, 13))?

Sub Insert_Setup_Photo()
'
Dim picToOpen As String
picToOpen = Application.GetOpenFilename _
(Title:="Select Setup Photo To Insert")


Set pic = ActiveSheet.Shapes.AddPicture(Filename:=picToOpen, _
LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)


End Sub

 

[Brandon212]

This is what I finally came up with:

Sub Insert_Setup_Photo()


ActiveSheet.Unprotect


    Dim picToOpen As String
    picToOpen = Application.GetOpenFilename _
    (Title:="Select Setup Photo To Insert")


    If picToOpen = "False" Then
        Exit Sub


    End If


Dim shp As Shape, t As Double, l As Double, w As Double, h As Double, r As Integer
Dim Cel As Range


CellHeight = 375 'Image Height, maintains scale
CellWidth = 670 'Image Width, maintains scale


   Set Cel = Range("B5:M29") 'Cells image be centered


      With Cel
        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picToOpen, _
        LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, left:=0, top:=0, width:=-1, height:=-1)
            shp.Locked = False
            




            shp.height = CellHeight


         If shp.width > CellWidth Then
            shp.width = CellWidth
                End If


            shp.left = .left + ((.width - shp.width) / 2)
            shp.top = .top + ((.height - shp.height) / 2)
                End With


ActiveSheet.Protect


End Sub

 

[Viona]

You can try by insert comment and edit properties then select fill effect and choot picture..
I wan't something like this to but rather image, I prefer a file uploading. Do we know how to do this in Excel 2016?

 

[Jaafar Tribak]

You can try by insert comment and edit properties then select fill effect and choot picture..
I wan't something like this to but rather image, I prefer a file uploading. Do we know how to do this in Excel 2016?

"I prefer a file uploading" .. What do you mean ?