Insert Picture as Icon with Custom Name

[Sumeluar]

Good day - I do not recall where I got the below macro from, can I get some assistance to have it modified to do the following:

- Allow to choose .gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif" (already doing so)
- Allow to customize a name to be visible at the bottom of the image
- Change the image to show it as an icon instead as if it was an embeded object

Sub InsertPicture()
Dim sPicture As String, pic As Picture
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = True
.Height = ActiveCell.Height
.Top = ActiveCell.Top
.Placement = xlMoveAndSize
End With
Set pic = Nothing
End Sub


Any assistance would be greatly appreciated.

Regards, Sumeluar

 

[Domenic]

You can use the Add method of the OleObjects object, for example...

Sub InsertPicture()

    Dim sPicture As String
    Dim oOleObj As OLEObject
    
    sPicture = Application.GetOpenFilename( _
        FileFilter:="Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
        Title:="Select Picture to Import")
    
    If sPicture = "False" Then Exit Sub
    
    Set oOleObj = ActiveSheet.OLEObjects.Add( _
        Filename:=sPicture, _
        Link:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Program Files (x86)\Internet Explorer\iexplore.exe", _
        IconIndex:=13, _
        IconLabel:="YourCustomizedNameHere")
        
    oOleObj.Height = ActiveCell.Height
        
End Sub

Change the IconFileName, IconIndex, and IconLabel accordingly. Have a look at the following link for additional information...

OLEObjects.Add method (Excel)

Office VBA reference topic

learn.microsoft.com

Hope this helps!

 

[Sumeluar]

You can use the Add method of the OleObjects object, for example...

Sub InsertPicture()

    Dim sPicture As String
    Dim oOleObj As OLEObject
   
    sPicture = Application.GetOpenFilename( _
        FileFilter:="Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
        Title:="Select Picture to Import")
   
    If sPicture = "False" Then Exit Sub
   
    Set oOleObj = ActiveSheet.OLEObjects.Add( _
        Filename:=sPicture, _
        Link:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="C:\Program Files (x86)\Internet Explorer\iexplore.exe", _
        IconIndex:=13, _
        IconLabel:="YourCustomizedNameHere")
       
    oOleObj.Height = ActiveCell.Height
       
End Sub

Change the IconFileName, IconIndex, and IconLabel accordingly. Have a look at the following link for additional information...

OLEObjects.Add method (Excel)

Office VBA reference topic

learn.microsoft.com

Hope this helps!

Domenic - Thank you for the help, I tried your approach but I could not get it to do what I am after as I was unable to input the custom name and when I saved the file the icon went to default, I made some modifications and now is doing exactly what I want until I "Save" it, at that point it loses the icon and the custom name.

This is where I have it at:

Sub Domenics_Modified()

Dim sPicture As String
Dim oOleObj As OLEObject
Dim embeddedFileName As String
sPicture = Application.GetOpenFilename( _
FileFilter:="Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
Title:="Select Picture to Import")
If sPicture = "False" Then Exit Sub
Do
embeddedFileName = VBA.InputBox("Enter custom picture name.", "Picture Name", "Custom Name")
If StrPtr(embeddedFileName) = 0 Then Exit Sub
Loop Until Len(embeddedFileName) > 0
Set oOleObj = ActiveSheet.OLEObjects.Add( _
Filename:=sPicture, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="E:\Icons\Picture.ico", _
IconIndex:=0, _
IconLabel:=embeddedFileName)
oOleObj.Top = ActiveCell.Top
oOleObj.Left = ActiveCell.Left
With oOleObj
.ShapeRange.Fill.Transparency = 1
.Border.LineStyle = xlNone
End With
End Sub

Regards, Sumeluar

 

[Domenic]

Yes, I can confirm the same behaviour. Unfortunately, I don't know why this happens, I'll have to do some research.

If I find a solution, I'll post back. In the meantime, maybe someone else here on the Board will have a suggestion.

Cheers!

 

[Domenic]

Okay, from what I can tell, it's likely due to an incorrect IconFileName. Here are a couple of suggestions...

1) Record a macro while you manually insert your object onto the worksheet, and see which file the generated code points to.

2) Have a look at the solution offered by @RoryA in the following link...

how to determine correct OLEObject Icon?

Hi everyone, have a little quandry here. I've created a vba sub that will allow a user to insert an object (as an icon) into the selected cell. Generally these are Office or PDF files, but may also be images or text files. The sub neatly formats the object to fit within the confines of the...

www.mrexcel.com

Hope this helps!

 

[Domenic]

If all else fails, you can simply set your IconLabel without the icon...

Set oOleObj = ActiveSheet.OLEObjects.Add( _
        Filename:=sPicture, _
        Link:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="", _
        IconIndex:=-1, _
        IconLabel:="YourCustomizedNameHere")

 

[Sumeluar]

If all else fails, you can simply set your IconLabel without the icon...

Set oOleObj = ActiveSheet.OLEObjects.Add( _
        Filename:=sPicture, _
        Link:=False, _
        DisplayAsIcon:=True, _
        IconFileName:="", _
        IconIndex:=-1, _
        IconLabel:="YourCustomizedNameHere")

Domenic - Thanks for the help but still no can do, when I save the workbook the picture does not preserve the new name.

Regards, Sumeluar.

 

[Domenic]

Domenic - Thanks for the help but still no can do, when I save the workbook the picture does not preserve the new name.

Regards, Sumeluar.

I did test it before posting the solution, and I just tested it again just to be sure, and it seems to work. When I save the workbook, it does save the new name.

Did you try the other suggestions in Post #5 ?