title: Inserting picture macro doesn't work on 64bit Excel
body: <p>I have the excel macro that insert picture from clipboard in comments (notes) in Excel. It works great on 32bit office but on 64bit not - I see the message that clipboard is empty. I have added PtsSafe and LongPtr but it doesn't still work. Is it possible to make the macro usable on 64bit excel? Thanks.</p>
  <pre><code>Option Explicit
  Option Private Module
  ' Checks the clipboard for a bitmap
  ' If found, creates a standard Picture object from the
  ' clipboard contetnts and saves it to a file
  
  ' The code requires a reference to the &quot;OLE Automation&quot; type library
  
  ' The code in this module has been derived primarily from _
    ' the PatsePicture sample on Stephen Bullen's Excel Page _
    ' - http://www.bmsltd.ie/Excel/Default.htm
  
  'Windows API Function Declarations
  #If VBA7 Then
  Public Declare PtrSafe Function ShellExecute Lib &quot;shell32.dll&quot; Alias &quot;ShellExecuteA&quot; (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr
  Public Declare PtrSafe Function IsClipboardFormatAvailable Lib &quot;user32&quot; (ByVal wFormat As Integer) As LongPtr
  Public Declare PtrSafe Function OpenClipboard Lib &quot;user32&quot; (ByVal hwnd As LongPtr) As LongPtr
  Public Declare PtrSafe Function GetClipboardData Lib &quot;user32&quot; (ByVal wFormat As Integer) As LongPtr
  Public Declare PtrSafe Function CloseClipboard Lib &quot;user32&quot; () As LongPtr
  Public Declare PtrSafe Function OleCreatePictureIndirect Lib &quot;olepro32.dll&quot; (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
  Public Declare PtrSafe Function CopyImage Lib &quot;user32&quot; (ByVal handle As LongPtr, ByVal un1 As LongPtr, ByVal n1 As LongPtr, ByVal n2 As LongPtr, ByVal un2 As LongPtr) As LongPtr
  #Else
  Public Declare Function ShellExecute Lib &quot;shell32.dll&quot; Alias &quot;ShellExecuteA&quot; (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  Public Declare Function IsClipboardFormatAvailable Lib &quot;user32&quot; (ByVal wFormat As Integer) As Long
  Public Declare Function OpenClipboard Lib &quot;user32&quot; (ByVal hwnd As Long) As Long
  Public Declare Function GetClipboardData Lib &quot;user32&quot; (ByVal wFormat As Integer) As Long
  Public Declare Function CloseClipboard Lib &quot;user32&quot; () As Long
  Public Declare Function OleCreatePictureIndirect Lib &quot;olepro32.dll&quot; (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  Public Declare Function CopyImage Lib &quot;user32&quot; (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
  #End If
  
  'The API format types we need
  Const CF_BITMAP = 2, IMAGE_BITMAP = 0, LR_COPYRETURNORG = &amp;H4
  'Declare a UDT to store a GUID for the IPicture OLE Interface
  Public Type GUID
          #If VBA7 Then
          Data1 As LongPtr
          #Else
          Data1 As Long
          #End If
          Data2 As Integer
          Data3 As Integer
          Data4(0 To 7) As Byte
  End Type
  'Declare a UDT to store the bitmap information
  Public Type uPicDesc
          #If VBA7 Then
          Size As LongPtr
          Type As LongPtr
          hPic As LongPtr
          hPal As LongPtr
          #Else
          Size As Long
          Type As Long
          hPic As Long
          hPal As Long
          #End If
  End Type
  
  #If VBA7 Then
  Public Declare PtrSafe Function EmptyClipboard Lib &quot;user32&quot; () As LongPtr
  Public Declare PtrSafe Function CopyEnhMetaFileA Lib &quot;gdi32&quot; (ByVal hENHSrc As LongPtr, ByVal lpszFile As String) As LongPtr
  Public Declare PtrSafe Function DeleteEnhMetaFile Lib &quot;gdi32&quot; (ByVal hEMF As LongPtr) As LongPtr
  #Else
  Public Declare Function EmptyClipboard Lib &quot;user32&quot; () As Long
  Public Declare Function CopyEnhMetaFileA Lib &quot;gdi32&quot; (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
  Public Declare Function DeleteEnhMetaFile Lib &quot;gdi32&quot; (ByVal hEMF As Long) As Long
  #End If
  
  #If VBA7 Then
  Const CF_ENHMETAFILE As LongPtr = 14
  #Else
  Const CF_ENHMETAFILE As Long = 14
  #End If
  
  '''''''''''''''
  Type BitMapFileHeader
    bfType1 As Byte
    bfType2 As Byte
    #If VBA7 Then
    bfSize As LongPtr
    #Else
    bfSize As Long
    #End If
    bfReserved1 As Integer
    bfReserved2 As Integer
    #If VBA7 Then
    bfOffBits As LongPtr
    #Else
    bfOffBits As Long
    #End If
  End Type
  Type BitMapInfo
    #If VBA7 Then
    biSize As LongPtr
    biWidth As LongPtr
    biHeight As LongPtr
    #Else
    biSize As Long
    biWidth As Long
    biHeight As Long
    #End If
    iplanes As Integer
    biBitCount As Integer
    #If VBA7 Then
    biCompression As LongPtr
    biSizeImage As LongPtr
    biXPelsPerMeter As LongPtr
    biYPelsPerMeter As LongPtr
    biClrUsed As LongPtr
    biClrImportant As LongPtr
    #Else
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
    #End If
  End Type
  Type BMPFile
       bmfh As BitMapFileHeader
       bmih As BitMapInfo
  End Type
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
          
  Sub MyComBars()
      Application.CommandBars(&quot;cell&quot;).Reset
      With Application.CommandBars(&quot;cell&quot;).Controls.Add(Type:=1, Before:=5)
          .OnAction = &quot;AddImage&quot;
          .Caption = &quot;Paste Image&quot;
      End With
  End Sub
  
  Sub AddImage()
      Dim ImaFile As String
      If Selection.Cells.Count &gt; 1 Then Exit Sub
          SaveClipboardToBMP
      ImaFile = SaveClipboardToBMP
      On Error GoTo nexterr
      ActiveCell.ClearComments
      ActiveCell.AddComment.Shape.Fill.UserPicture (ImaFile)
      ActiveCell.Comment.Shape.Width = ReadShowSameBMPInfo(ImaFile, 1)
      ActiveCell.Comment.Shape.Height = ReadShowSameBMPInfo(ImaFile, 2)
      Exit Sub
  nexterr:
      MsgBox &quot;Clipboard is empty&quot;, vbCritical, &quot;Error&quot;
      ActiveCell.ClearComments
  End Sub
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  Public Function SaveClipboardToBMP() As String
          Dim fn As String
      On Error Resume Next
          fn = Clip2FileEx
          SaveClipboardToBMP = fn
      If Dir(fn) = &quot;&quot; Then MsgBox &quot;File  &quot; &amp; fn &amp; &quot;  not found&quot;, vbExclamation, &quot;File not found&quot;
          Exit Function
  End Function
  
  Public Function Clip2FileEx() As String
      Dim strOutputPath As String, oPic As IPictureDisp, PicPath As String
      On Error Resume Next
          MkDir Environ(&quot;TEMP&quot;) &amp; &quot;\Excel\&quot;
      PicPath = Environ(&quot;TEMP&quot;) &amp; &quot;\Excel\&quot;: PicPath = PicPath &amp; &quot;Picture&quot; &amp; Format(Now, &quot;DD-MMM-YYYY_HH-NN-SS&quot;) &amp; &quot;.bmp&quot;
      Set oPic = GetClipPicture()
      If Not oPic Is Nothing Then
          SavePicture oPic, PicPath
          Clip2FileEx = PicPath
      Else
          Clip2FileEx = &quot;&quot;
          'MsgBox &quot;Unable to retrieve bitmap from clipboard&quot;
      End If
  End Function
  
  Function GetClipPicture() As IPicture
      #If VBA7 Then
          Dim H As LongPtr, hPicAvail As LongPtr, hPtr As LongPtr, hPal As LongPtr, hCopy As LongPtr
      #Else
          Dim H As Long, hPicAvail As Long, hPtr As Long, hPal As Long, hCopy As Long
      #End If
      'Check if the clipboard contains a bitmap
      hPicAvail = IsClipboardFormatAvailable(CF_BITMAP)
      If hPicAvail &lt;&gt; 0 Then
          'Get access to the clipboard
          H = OpenClipboard(0&amp;)
          If H &gt; 0 Then
              'Get a handle to the image data
              hPtr = GetClipboardData(CF_BITMAP)
              hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
              'Release the clipboard to other programs
              H = CloseClipboard
              'If we got a handle to the image, convert it into a Picture object and return it
              If hPtr &lt;&gt; 0 Then Set GetClipPicture = CreatePicture(hCopy, 0, CF_BITMAP)
          End If
      End If
  End Function
  
  #If VBA7 Then
  Public Function CreatePicture(ByVal hPic As LongPtr, ByVal hPal As LongPtr, ByVal lPicType) As IPicture
  #Else
  Public Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture
  #End If
      ' IPicture requires a reference to &quot;OLE Automation&quot;
  #If VBA7 Then
      Dim r As LongPtr, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
  #Else
      Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
  #End If
      'OLE Picture types
      Const PICTYPE_BITMAP = 1
      ' Create the Interface GUID (for the IPicture interface)
      With IID_IDispatch
          .Data1 = &amp;H7BF80980
          .Data2 = &amp;HBF32
          .Data3 = &amp;H101A
          .Data4(0) = &amp;H8B
          .Data4(1) = &amp;HBB
          .Data4(2) = &amp;H0
          .Data4(3) = &amp;HAA
          .Data4(4) = &amp;H0
          .Data4(5) = &amp;H30
          .Data4(6) = &amp;HC
          .Data4(7) = &amp;HAB
      End With
      ' Fill uPicInfo with necessary parts.
      With uPicInfo
          .Size = Len(uPicInfo)    ' Length of structure.
          .Type = PICTYPE_BITMAP    ' Type of Picture
          .hPic = hPic    ' Handle to image.
          .hPal = 0    ' Handle to palette (if bitmap).
      End With
      ' Create the Picture object.
      r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
      ' Return the new Picture object.
      Set CreatePicture = IPic
  End Function
  
  #If VBA7 Then
  Public Function ReadShowSameBMPInfo(fn As String, par As Byte) As LongPtr
  #Else
  Public Function ReadShowSameBMPInfo(fn As String, par As Byte) As Long ' par=1 gives the image width , par=2 gives the image height,
  #End If
    Dim bitmap1 As BMPFile
    Open fn For Binary As #1
    With bitmap1
      Get #1, , .bmfh
      Get #1, , .bmih
      Close #1
      Select Case par
          Case 1
              ReadShowSameBMPInfo = .bmih.biWidth
          Case 2
              ReadShowSameBMPInfo = .bmih.biHeight
      End Select
  '    MsgBox &quot;Type = &quot; &amp; Chr(.bmfh.bfType1) &amp; Chr(.bmfh.bfType2) &amp; Chr(10) &amp; &quot;Size = &quot; &amp; .bmih.biWidth &amp; &quot;x&quot; &amp; .bmih.biHeight, , fn
    End With
  End Function
  </code></pre>