How can I extract a fill pattern from a cell comments field

mzgaljic

New Member
Joined
Jun 21, 2008
Messages
5
I have a file where comments are used for some cells. The user does not insert any text into these comments fields, but uses the comments feature to display pictures.
A picture is used for the fill pattern of the cell (inserted through fill effects) and that picture is what is displayed when someone moves the mouse over the cell.
The "fill pattern picture" becomes part of the excel file and my question is how can I extract this picture and use it somewhere else.
I can send you the file if needed.
Thanks.
 
Last edited:

Some videos you may like

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

mzgaljic

New Member
Joined
Jun 21, 2008
Messages
5
Thanks for checking.... I thought that it could not be done in a normal fashion but are there any programs or procedures that can dismantle an excel file in such a way as to extract things of this nature?
 

softwareguru

Board Regular
Joined
Dec 3, 2007
Messages
63
the picture is a thumbnail of the original that is stored on the creators hard drive and therefore is not their to get.
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hello, mzgaljic,
WELCOME to the BOARD!!!!!

I had a play with this, but could not get through, though it seems to me that this should be possible. Looks like something for our member "Jafaar Tribak". Perhaps send him a private message with a link to this thread.
I'll post a note to some MVPs too.

kind regards,
Erik
 

Tom Schreiner

Well-known Member
Joined
Mar 18, 2002
Messages
6,867
You could write some code to extract the picture. However, it would be much easier to simply increase the zoom and and use any number of free screen capture utilities. If you have a small handful of pictures, send the file to me and I'll capture the pictures for you... tstom@fuse.net
 

mzgaljic

New Member
Joined
Jun 21, 2008
Messages
5
Thanks guys.

Just a note..... although the picture originated from the hard drive of the person that created the file.... the picture follows the file.

It is now on my PC and the file still has the pictures that are the fill pattern.

When you highlight the comments of the cell and go to fill effects.... you can see the picture that is the fill pattern effect, so it is in the file and not on the originator's hard drive.

It would be great if it can be extracted......somehow.

Thanks for all your help. I know this is a tricky one.
 

mzgaljic

New Member
Joined
Jun 21, 2008
Messages
5
SUPER IDEA.....!!!!!!!!

I used a screen capture program.....!!!!!

SUPER...!!!!!!

Thank you so much....
I just tried and it worked.

What a great idea and so simple....great work-around to what I was asking.

Super-Idea...!!!!

Thanks...!!!!!!
 

mzgaljic

New Member
Joined
Jun 21, 2008
Messages
5
Problem solved.
Thanks to everyone.

Especially "Right_Click"

Great job....!!
 

Tom Schreiner

Well-known Member
Joined
Mar 18, 2002
Messages
6,867
Well... I agree that using a simple screen capture program is the most prudent way to go. With that in mind, anybody who would waste time writing code(or copying and pasting from MSDN) probably needs to get a life. Unless it's Sunday evening and there is nothing else to do... :)

Download example.
<a href="http://home.fuse.net/tstom/ExtractPicturesFromComments.zip"><img src="http://home.fuse.net/tstom/zip.gif"width="48"height="48"border="0"></a> <a href="http://home.fuse.net/tstom/ExtractPicturesFromComments.zip">ExtractPicturesFromComments.zip</a>

So here it is >> for the one other person in the world who would like to get pictures from comments... :)

Usage Example:
Code:
'gets all pictures in comments located in range a1 to z100
'saves them as bmp file to thisworkbook.path\CommentPics\
Private Sub CommandButton1_Click()
    Call SaveCommentPicturesToFile(Range("A1:Z100"))
End Sub
Module:
Code:
Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type


Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Private Const CF_BITMAP As Long = 2
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4
Private Const IMAGE_ENHMETAFILE As Long = 3


Sub SaveCommentPicturesToFile(CommentsInThisRange As Range)
    Dim r As Range, c As Comment
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    MkDir ThisWorkbook.Path & Application.PathSeparator & "CommentPics"
    On Error GoTo 0
    
    ChDir ThisWorkbook.Path & Application.PathSeparator & "CommentPics"
    
    For Each r In CommentsInThisRange
        Set c = r.Comment
        If Not c Is Nothing Then
            c.Visible = True
            c.Shape.CopyPicture xlScreen, xlBitmap
            c.Visible = False
            SavePicture PicFromClip, "CPic_" & r.Address(0, 0) & ".bmp."
        End If
    Next
    
End Sub

Private Function PicFromClip() As IPictureDisp
    Dim BitmapHandle As Long, Pic As PicBmp, IPic As IPictureDisp, IID_IDispatch As GUID

    
    If OpenClipboard(0) <> 0 Then
        BitmapHandle = CopyImage(GetClipboardData(2), 0, 0, 0, LR_COPYRETURNORG)
        CloseClipboard
    End If
    
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With

    With Pic
        .Size = Len(Pic)
        .Type = 1
        .hBmp = BitmapHandle
        .hPal = vbNull
    End With

    OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
    Set PicFromClip = IPic
    
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,099,492
Messages
5,468,927
Members
406,620
Latest member
Gitani123

This Week's Hot Topics

Top