![]() Private Function fnOLEError(lErrNum As Long) As Stringĭim vFile As Variant, sFilter As String, lPicType As Long, oPic As IPictureDisp If r 0 Then Debug.Print "Create Picture: " & fnOLEError(r) ' If an error occured, show the description R = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic) hPal = IIf(lPicType = CF_BITMAP, hPal, 0) ' Handle to palette (if bitmap). Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) ' Type of Picture Size = Len(uPicInfo) ' Length of structure. ' Create the Interface GUID (for the IPicture interface) ' IPicture requires a reference to "OLE Automation"ĭim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture If hPtr 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType) 'If we got a handle to the image, convert it into a Picture object and return it HCopy = CopyEnhMetaFile(hPtr, vbNullString) HCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) 'Create our own copy of the image on the clipboard, in the appropriate format. HPicAvail = IsClipboardFormatAvailable(lPicType) 'Check if the clipboard contains the required format LPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE) 'Convert the type of picture requested from the xl constant to the API constant 'The API format types we're interested inįunction PastePicture(Optional lXlPicType As Long = xlPicture) As IPictureĭim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long 'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.ĭeclare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.ĭeclare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 'Convert the handle into an OLE IPicture interface. Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long 'Does the clipboard contain a bitmap/metafile? 'Declare a UDT to store the bitmap information 'Declare a UDT to store a GUID for the IPicture OLE Interface It turned out that the code has to be placed in two seperate modules as in one module it did not work. I guess that the code from module 1 can be made more efficient for my purpose. ![]() ![]() Before you run the code you have to select "the area to be pictured" first. I got rid of the userform and used the code from the "Save" button for non-userform related code. The code from Stephen Bullen comes with a userform. ![]() Have questions or feedback about Office VBA or this documentation? Please see Office VBA support and feedback for guidance about the ways you can receive support and provide feedback.The following link should work: The name of the file is PastePicture.Zip TextBox1.Text = "Move this data to the " _ 'Need to select text before copying it to Clipboard Two TextBox controls named TextBox1 and TextBox2.To use this example, copy this sample code to the Declarations portion of a form. The Copy and GetText methods are also used. The GetFromClipboard method transfers the data from the Clipboard to a DataObject. The following example demonstrates data movement from a TextBox to the Clipboard, from the Clipboard to a DataObject, and from a DataObject into another TextBox.
0 Comments
Leave a Reply. |
AuthorWrite something about yourself. No need to be fancy, just an overview. ArchivesCategories |