VBAでクリップボードにコピーが突然不調
以下のマクロが動作不調で、クリップボードにコピーされなくなりました。
Sub CopyToClipboard()
Dim tempText As String
tempText = "文字列"
' クリップボードにコピー
With New MSForms.DataObject
.SetText tempText
.PutInClipboard
End With
End Subただし、上記のコードは「Microsoft Forms 2.0 Object Library」を参照している前提で書かれています。もし参照ができていない場合は、以下の手順で参照を追加してください。
- Excelを開いている状態で、Alt + F11を押してVBAエディタを開きます。
- ツールバーの「ツール」 → 「参照設定」をクリックします。
- 「Microsoft Forms 2.0 Object Library」にチェックを入れ、OKボタンをクリックします。
これで再度コードを実行すると、指定した文字列がクリップボードにコピーされます。
ただし、突然、使用できなくなり、以下に変更したところ、動作可能になりました。
Declare PtrSafe Sub OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr)
Declare PtrSafe Sub EmptyClipboard Lib "user32.dll" ()
Declare PtrSafe Sub CloseClipboard Lib "user32.dll" ()
Declare PtrSafe Sub SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr)
Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function lstrcpy Lib "kernel32.dll" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Sub CopyToClipboard()
Dim tempText As String
tempText = "文字列"
' クリップボードにコピー
CopyTextToClipboard tempText
End Sub
Sub CopyTextToClipboard(text As String)
Dim hGlobalMemory As LongPtr
Dim lpGlobalMemory As LongPtr
Dim lpClipBoard As LongPtr
' クリップボードを開く
OpenClipboard 0&
' クリップボードを空にする
EmptyClipboard
' グローバルメモリを確保
hGlobalMemory = GlobalAlloc(&H42, LenB(text) + 2)
' グローバルメモリをロック
lpGlobalMemory = GlobalLock(hGlobalMemory)
' メモリに文字列を書き込む
lstrcpy ByVal lpGlobalMemory, ByVal text
' グローバルメモリのロックを解除
GlobalUnlock hGlobalMemory
' クリップボードにデータをセット
SetClipboardData &H1, hGlobalMemory
' クリップボードを閉じる
CloseClipboard
End SubこれはAPIを使用した手段で、参照設定は不要です。
Follow me!
