Adding worksheet picture to a comment

craig.penny

craig.penny

Well-known Member
Joined
May 8, 2009
Messages
656
Hello all you Excel nerds! :)

I'm trying to insert a picture into a cell comment. I've found plenty of threads but they are all for situations where the picture is not already within the worksheet or workbook. This is what I've been trying with all different things in place of the "???????" but I haven't figured it out.

Code: 
Sub NamePic()
      Dim Pic As Object
      Dim Nm As String: Nm = "Picture 2"
      Dim s As Worksheet: Set s = ActiveSheet
      
      On Error Resume Next
      
      s.Cells(1, 2).Select
      Set Pic = s.Pictures(Nm)
      
      s.Cells(1, 5).AddComment
      s.Cells(1, 5).Comment.Shape.Height = Pic.Height
      s.Cells(1, 5).Comment.Shape.Width = Pic.Width
      s.Cells(1, 5).Comment.Shape.Fill.UserPicture   ????????
      
End Sub

"Picture 2" is definitely the right name but now what?

If you read this and you don't know the answer but just have an idea I'd love to hear it!

:) Thanks in advance! :)
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
I'm doing a drive-by here because I don't know the answer and I have to leave here in a minute. But I'd hunt down the following -- Stephen Bullen & Rob Bovey did a table-driven commandbar building module for Excel 2003 and lower several years ago. Part of that logic involved a custom subroutine or function (I forget which) that they used to copy a picture from the surface of the worksheet and paste it into controls. It may be that the solution involves using their picture-pasting function? Complete shot in the dark and I apologize beforehand if it ends up being a snipe hunt.

Edit - not looking like you can PASTE in a picture interactively; so that might be a snipe hunt indeed.. Looks like you'd have to actually export the picture to a file and then import it.
 
Last edited:
Upvote 0
It seems like the easiest way to handle it then is to save it to the desktop, import it, then delete it from the desktop. Is that how you would do it?
 
Upvote 0
As far as I know, that's the only way to do it. You cannot, as Greg mentioned, paste the picture in and userpicture has to take a file name.
 
Upvote 0
Just a note - while you might not have to export it to the user's desktop, it's probably not a bad idea (that or his myDocs). Don't use c:\ as a possible export path because under Win7, some users don't have write access to C:\ (I learned that one the hard way).
 
Upvote 0
Or save it to the workbook's path, since you need to have write access there as a rule.
 
Upvote 0
I'm getting an error when I try to run this and I'm sure the solution is easy but I'm just not seeing it.

Code: 
      Dim s As Worksheet: Set s = ActiveSheet
      Dim Nm As String: Nm = "CommentPic"
      Dim Pic As Object: Set Pic = s.Pictures(Nm)
      Dim Pth As String: Pth = CStr(ThisWorkbook.Path) & "\Temp.JPG"
    
      If Not Pic Is Nothing Then Pic.SaveAs (Pth)

I really appreciate your help!
 
Upvote 0
It's not that easy, I'm afraid. You'll need to use copypicture, then paste to a blank chart so that you can then export the chart to file.
 
Upvote 0
Here is an adaptation of the Stephen Bullen use of the OleCreatePictureIndirect API :

In a standard module :

Code: 
Option Explicit
 
'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
'Declare a UDT to store the bitmap information
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type
 
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
 
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
 
Private Declare Function CloseClipboard Lib "user32" _
() As Long
 
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
 
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const PICTYPE_BITMAP = 1
 
Private Sub Shape_to_Comment(Shape As Shape, Comment As Comment)
 
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim IPic As IPicture
    Dim hPtr As Long
    Dim sTempFileName As String
 
    sTempFileName = ThisWorkbook.Path & "\temp.bmp"
 
    'Copy and retrieve the handle to the range Image
    Shape.CopyPicture xlScreen, xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    CloseClipboard
 
    'Create the interface GUID for the picture
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
 
    ' Fill uPicInfo with necessary parts.
    With uPicinfo
        .Size = Len(uPicinfo) ' Length of structure.
        .Type = PICTYPE_BITMAP ' Type of Picture
        .hPic = hPtr ' Handle to image.
        .hPal = 0 ' Handle to palette (if bitmap).
    End With
 
   'Create the Picture Object
   OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
 
    'Save Picture Object to disk.
    stdole.SavePicture IPic, sTempFileName
    
    Comment.Shape.Fill.UserPicture sTempFileName
    
    Kill sTempFileName
 
End Sub

Usage :

The one liner below will copy shape1 to the comment in cell A1 :

Code: 
Sub Test()
 
    Shape_to_Comment ActiveSheet.Shapes(1), ActiveSheet.Range("a1").Comment
 
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Email Body
Replies
9
Views
671
Trixterz
T
O
  • Solved
VBA - floating photo
Replies
3
Views
496
RoryA
RoryA
msword
  • Question Question
rescuing comments section from the 80's trap
Replies
3
Views
154
Trebor76
T
J
  • Question Question
Macro to pull Office 365 'Comments' onto new tab like I previously did with what's now 'Notes'
Replies
1
Views
131
jkouvel
J
M
  • Question Question
Prevent worksheet change from triggering when similar macro is executed?
Replies
1
Views
141
AlphaFrog
AlphaFrog

Forum statistics

Threads
1,224,602
Messages
6,179,843
Members
452,948
Latest member
UsmanAli786

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top