クリップボードのデータを変えずにイメージ付きのメニューを作成するには? (ID:82331)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 同じことで悩んでいたので投稿しておきます。 PDFMakerのアドインマクロ(AutoExecNew.bas)を参考にしました。 ・クリップボード保存：SaveAndEmptyClipboard() ・クリップボード復元：RestoreClipboard() ************ サンプルソース ***************************************** Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Type DataArray bData() As Byte fID As Long End Type Dim nFormats As Long Dim ClipboardData() As DataArray Public Sub SaveAndEmptyClipboard() Attribute SaveAndEmptyClipboard.VB_ProcData.VB_Invoke_Func = " \n14" Dim format As Long Dim hMem As Long Dim mSize As Long Dim mPtr As Long nFormats = 0 OpenClipboard (0) format = EnumClipboardFormats(0) If (format <> 0) Then Do If IsClipboardFormatAvailable(format) Then hMem = GetClipboardData(format) mSize = GlobalSize(hMem) mPtr = GlobalLock(hMem) If mSize > 0 Then nFormats = nFormats + 1 ReDim Preserve ClipboardData(0 To nFormats) ReDim ClipboardData(nFormats - 1).bData(0 To mSize - 1) CopyMemory ClipboardData(nFormats - 1).bData(0), ByVal mPtr, mSize ClipboardData(nFormats - 1).fID = format End If GlobalUnlock hMem End If format = EnumClipboardFormats(format) Loop While (format <> 0) End If EmptyClipboard CloseClipboard End Sub Public Sub RestoreClipboard() Attribute RestoreClipboard.VB_ProcData.VB_Invoke_Func = " \n14" Dim format As Long Dim hMem As Long Dim mSize As Long Dim mPtr As Long Dim i As Long If nFormats <= 0 Then Exit Sub End If OpenClipboard (0) For i = 0 To nFormats - 1 mSize = UBound(ClipboardData(i).bData) - LBound(ClipboardData(i).bData) + 1 hMem = GlobalAlloc(0, mSize) If hMem <> 0 Then mPtr = GlobalLock(hMem) CopyMemory ByVal mPtr, ClipboardData(i).bData(0), mSize GlobalUnlock hMem SetClipboardData ClipboardData(i).fID, hMem End If Next i CloseClipboard End Sub