このようなコードを使用して、クリップボードからテキストを取得しています。
Dim DataObj As New MSForms.DataObject
DataObj.GetFromClipboard
myString = DataObj.GetText
エラー処理を使用して、クリップボードが空の場合を回避します。エラートラップを[未処理のエラーで中断]に設定している限り、すべてが正常です。
ただし、無関係な理由で、エラートラップを[すべてのエラーで中断]に設定すると、空のクリップボードが検出されると、DataObj.GetText
でエラーがスローされます。空のクリップボードの処理を回避するために、上流でさらに適用できるテストはありますか?
これは役に立ちますか?
Sub GetClipBoardText()
Dim DataObj As MSForms.DataObject
Set DataObj = New MsForms.DataObject '<~~ Amended as per jp's suggestion
On Error GoTo Whoa
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
myString = DataObj.GetText(1)
MsgBox myString
Exit Sub
Whoa:
If Err <> 0 Then MsgBox "Data on clipboard is not text or is empty"
End Sub
空のクリップボードも処理できることに気づくでしょう。
以下のコードを使用して、上記のコードをテストする前にクリップボードを空にすることができます。モジュールに貼り付けてください。
Private Declare Function OpenClipboard Lib "User32.dll" _
(ByVal hWndNewOwner As Long) As Long
Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare Function CloseClipboard Lib "User32.dll" () As Long
Public Sub ClearClipboard()
Dim Ret
Ret = OpenClipboard(0&)
If Ret <> 0 Then Ret = EmptyClipboard
CloseClipboard
End Sub
編集:OPによる新しいリクエスト
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Sub Sample()
If (CountClipboardFormats() = 0) = True Then
MsgBox "Clipboard is empty"
Else
MsgBox "Clipboard is not empty"
End If
End Sub
これが他の誰かを助けることを願っています:
Siddharth-routによって投稿されたコードで「ユーザー定義型が定義されていません」というエラーが発生しました
「Microsoft Forms 2.0 Object Library」ライブラリが見つからない/アクティブ化されていないことが判明.
これで動作するようになりました( http://Excel-macro.tutorialhorizon.com/vba-Excel-reference-libraries-in-Excel-workbook/ ):
「リストに必要な参照が見つからない場合があります。その場合、system32からFM20.DLLファイルを参照する必要があるため、ツール/参照リストに「Microsoft Forms 2.0 Object Library」が見つからないとします。」
次のコードをb4だけを追加して、デバッグ用の改行を追加します。そのエラーは、テスト後に消えました。
myString = DataObj.GetText(1)
MsgBox myString