参照設定でチェックをいれて、Microsoft Office 9.0 Object Library を使って、イメージ付きのメニューを作成しようとして、以下のようなプログラムを作りました。
Private lcMenuBtn As CommandBarButton
…
Clipboard.Clear
Clipboard.SetData LoadResPicture(101, vbResBitmap)
lcMenuBtn.PasteFace
Clipboard.Clear
…
プログラムは成功して、イメージのついたメニューを作成することはできたのですが、これでは、クリップボードにイメージを一度配置しているため、もともとのクリップボードのデータは失われてしまい、不都合です。
自分でも、ClipboardオブジェクトのGetText、SetTextなどを使って、クリップボードのデータを一時保持しようとしたのですが、クリップボードに入ってくるデータ形式がさまざまで、埒があきません。
どなたか、これを解決するよい方法をご存知の方がいらっしゃいましたら、どうか、ご教授お願いします。
同じことで悩んでいたので投稿しておきます。
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