GDIplusCODE

Pictureオブジェクトをclipboardにコピーする

VB6だと簡単らしいが、VBAで使えるものが意外と無い
どこで見つけたものか出典を見失ってしまいました。作者様申し訳ありません。
API、定数等は、「画像をリサイズ、回転してクリップボードにコピー→別途ActiveCellに貼り付け」のxl2010対応版を参照ください。


' ビットマップ形式のPictureをクリップボードにコピー
Private Function CopyBitmapPictureToCB(ByVal pic As Object) As Boolean
    Dim hBmp As Long
    If pic Is Nothing Then Exit Function
    If pic.Type <> PICTYPE_BITMAP Then Exit Function
    hBmp = pic.handle
    hBmp = CopyImage(hBmp, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    If hBmp = 0 Then Exit Function
    If OpenClipboard(0) Then
        EmptyClipboard
        If SetClipboardData(CF_BITMAP, hBmp) Then
            hBmp = 0
            CopyBitmapPictureToCB = True
        End If
        CloseClipboard
    End If
    If hBmp Then DeleteObject hBmp
End Function