おしゃれにいけてる?

散歩やお買い物のことなどを書いています・・・

Entries

 EXCEL VBA TIPs. [ クリップボードにコピーした画像を、ペーストするために取りだす方法。]

 クリップボードにコピーした画像を、クリップボードから Picture オブジェクトとして取りだしてペーストに利用する方法。(コピペに利用)

これは、ネット上の掲示板にあった物を、ちょっとだけ修正したもの。仕組みが理解できてない。情報が無くなると困るので、ここにコピー。

いつかは、これが理解できるようになりたいと思ってる。

'----------------------- by shira
'モジュールの先頭に書く
Option Explicit
Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
  cbSizeofstruct As Long
  picType As Long
  hemf As Long
  Padding(0 To 1) As Long
End Type
Const PICTYPE_ENHMETAFILE = 4

Private Declare Function OleCreatePictureIndirect _
    Lib "olepro32.dll" _
    (lpPictDesc As PICTDESC, riid As GUID, _
    ByVal fOwn As Long, lplpvObj As Object) As Long
Private Declare Function OpenClipboard Lib "user32" _
    (ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
    (ByVal uFormat As Long) As Long

Const CF_ENHMETAFILE = 14
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
    Alias "CopyEnhMetaFileA" _
    (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
    (ByVal hemf As Long) As Long


'クリップボードから Picture オブジェクトを取り出す関数
'※画像がない場合は nothing を返す

Public Function LoadPictureFromCB() As Object

  Dim IID_IDispatch As GUID
  Dim pd As PICTDESC
  Dim objResult As Object
  Dim hemf As Long

  If OpenClipboard(0) Then
   hemf = GetClipboardData(CF_ENHMETAFILE)
   ' ハンドルを複製してから使用する
   hemf = CopyEnhMetaFile(hemf, vbNullString)
   CloseClipboard
  End If
  If hemf = 0 Then
   Set LoadPictureFromCB = Nothing
   Exit Function ' 失敗
  End If
  With IID_IDispatch
   .Data1 = &H20400
   .Data4(0) = &HC0
   .Data4(7) = &H46
  End With
  With pd
   .cbSizeofstruct = Len(pd)
   .picType = PICTYPE_ENHMETAFILE
   .hemf = hemf
   End With

  If OleCreatePictureIndirect(pd, IID_IDispatch, _
                1, objResult) >= 0 Then
   ' 成功時
   Set LoadPictureFromCB = objResult
  Else
   ' 失敗時
   DeleteEnhMetaFile hemf
   Set LoadPictureFromCB = Nothing
  End If

End Function

PS. もし、この記事が役に立ったら、「拍手」で知らせて下さい。

スポンサードリンク

Comment

Comment_form

管理者のみ表示。

左サイドメニュー

プロフィール

Author:ジョニー

ゆるゆると日々を過ごしてしまう、ダメダメ野郎の航海日記。



クリック (・。・)yoro

このブログ内を検索

最近の記事

カテゴリー

最近のコメント

QRコード

QRコード

月別アーカイブ

右サイドメニュー

カレンダー

02 | 2020/03 | 04
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -

スポンサードリンク

FC2カウンター

#1413