+ Reply to Thread
Results 1 to 3 of 3

Embed image in cell

Hybrid View

  1. #1
    Registered User
    Join Date
    10-24-2008
    Location
    M E
    Posts
    6

    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.
    Last edited by VBA Noob; 10-26-2008 at 02:33 PM.

  2. #2
    Registered User
    Join Date
    10-24-2008
    Location
    M E
    Posts
    6
    Quote Originally Posted by AceX View Post
    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
    Last edited by VBA Noob; 10-26-2008 at 02:37 PM.

  3. #3
    Forum Contributor VBA Noob's Avatar
    Join Date
    04-25-2006
    Location
    London, England
    MS-Off Ver
    xl03 & xl 07(Jan 09)
    Posts
    11,988
    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
    _________________________________________


    Credo Elvem ipsum etian vivere
    _________________________________________
    A message for cross posters

    Please remember to wrap code.

    Forum Rules

    Please add to your signature if you found this link helpful. Excel links !!!

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1