pasting image from clipboard into image control
Hello,
i found this code on the net which i want to use to paste an image from the clipboard into an image control in word.
When i try to compile the code, i get the following error on line:
Method or object not found.
lngReturn = OpenClipboard(Application.hWnd)
.hWnd gets highlighted.
Does anyone know why this is not working?
I am using Office 2016 64bit
This is is the complete code:
Code:
Option Explicit
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
ByRef PicDesc As PIC_DESC, _
ByRef RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
ByRef IPic As IPictureDisp) As Long
Private Declare Function CopyEnhMetaFileA Lib "gdi32.dll" ( _
ByVal hemfSrc As Long, _
ByVal lpszFile As String) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Integer) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" ( _
ByVal hObject As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
ByVal lpsz As Any, _
ByRef pCLSID As GUID) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PIC_DESC
lngSize As Long
lngType As Long
lnghPic As Long
lnghPal As Long
End Type
Private Const PICTYPE_ENHMETAFILE = 4
Private Const CF_ENHMETAFILE = 14
Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Private llngCopy As Long
Private Function Paste_Picture() As IPictureDisp
Dim lngReturn As Long, lngPointer As Long
If CBool(IsClipboardFormatAvailable(CF_ENHMETAFILE)) Then
lngReturn = OpenClipboard(Application.hWnd)
If lngReturn > 0 Then
lngPointer = GetClipboardData(CF_ENHMETAFILE)
llngCopy = CopyEnhMetaFileA(lngPointer, vbNullString)
Call CloseClipboard
If lngPointer <> 0 Then Set Paste_Picture = _
Create_Picture(llngCopy, 0&, PICTYPE_ENHMETAFILE)
End If
End If
End Function
Private Function Create_Picture( _
ByVal lnghPic As Long, _
ByVal lnghPal As Long, _
ByVal lngPicType As Long) As IPictureDisp
Dim udtPicInfo As PIC_DESC, udtID_IDispatch As GUID
Dim objPicture As IPictureDisp
Call CLSIDFromString(StrPtr( _
GUID_IPICTUREDISP), udtID_IDispatch)
With udtPicInfo
.lngSize = Len(udtPicInfo)
.lngType = lngPicType
.lnghPic = lnghPic
.lnghPal = lnghPal
End With
Call OleCreatePictureIndirect(udtPicInfo, _
udtID_IDispatch, 0&, objPicture)
Set Create_Picture = objPicture
Set objPicture = Nothing
End Function
Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim objPicture As IPictureDisp
Set objPicture = Paste_Picture()
If Not objPicture Is Nothing Then
Image1.Picture = objPicture
Else
MsgBox "Hat nicht funktioniert", vbCritical, "Error"
End If
Call DeleteObject(llngCopy)
End Sub
