Embed image in cell

Thanks, that code really worked.

http://www.excelforum.com/excel-misc...e-in-cell.html

by the way , why there is no option for adding a picture manually to the comment of a cell?
when editing a comment the Insert picture from file from the Insert menu is disabled ! (Offic XP)

and can you please edit the code so the Width and Height of the comment box is set exactly to the dimensions of the picture? (that is how to get the exact width and height of the picture being inserted from code in excel ?)

thanks.

Originally Posted by AceX

Thanks, that code really worked.

by the way , why there is no option for adding a picture manually to the comment of a cell?
when editing a comment the Insert picture from file from the Insert menu is disabled ! (Offic XP)

and can you please edit the code so the Width and Height of the comment box is set exactly to the dimensions of the picture? (that is how to get the exact width and height of the picture being inserted from code in excel ?)

thanks.

I found the solution to my question here:

http://www.vbaexpress.com/forum/show...87&postcount=8

Sub ResizePic() 
    Dim Img As ImageFile 
    Dim IP As ImageProcess 
    Dim sFName As String 
    Dim i As Integer 
     
    On Error Goto AutoError 
     'Get Dir
    sFName = Dir("C:\WINDOWS\Web\Wallpaper\") 
     
    Set Img = CreateObject("WIA.ImageFile") 
    Set IP = CreateObject("WIA.ImageProcess") 
     'Set i to one
    i = 1 
    Do While Len(sFName) > 0 
        If Right(sFName, 3) = "jpg" Then 'Adjust to suit
             'Load File
            Img.LoadFile "C:\WINDOWS\Web\Wallpaper\" & sFName & "" 
             'Resize
            IP.Filters.Add IP.FilterInfos("Scale").FilterID 
            IP.Filters(i).Properties("MaximumWidth") = 150 'Will resize to 133
            IP.Filters(i).Properties("MaximumHeight") = 100 'Will resize to 100
             'Apply changes
            Set Img = IP.Apply(Img) 
             'Save File
            Img.SaveFile "C:\WINDOWS\Web\Wallpaper\" & "Thumb" & sFName & "" 
             'increment IP.Filters
            i = i + 1 
        End If 
         'Next File
        sFName = Dir 
    Loop 
    Set Img = Nothing 
    Set IP = Nothing 
    Exit Sub 
AutoError: 
     'Automation Error if  Files are not found or saved file exist
    If Err.Number = -2147024816 Then 
        MsgBox "File Already Exist", vbOKOnly 
        Resume Next 
    Else 
        MsgBox Err.Number & " " & Err.Description 
    End If 
     
End Sub

AceX,

You're thread move to their own thread as per forum rules below which you should read

Thanks for sharing you're solution. I will mark it solved for you this time

VBA Noob