web-dev-qa-db-ja.com

GetTextを使用してクリップボードからテキストを取得-空のクリップボードでのエラーを回避

このようなコードを使用して、クリップボードからテキストを取得しています。

Dim DataObj As New MSForms.DataObject
DataObj.GetFromClipboard
myString = DataObj.GetText

エラー処理を使用して、クリップボードが空の場合を回避します。エラートラップを[未処理のエラーで中断]に設定している限り、すべてが正常です。

ただし、無関係な理由で、エラートラップを[すべてのエラーで中断]に設定すると、空のクリップボードが検出されると、DataObj.GetTextでエラーがスローされます。空のクリップボードの処理を回避するために、上流でさらに適用できるテストはありますか?

18
Roy

これは役に立ちますか?

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
19
Siddharth Rout

これが他の誰かを助けることを願っています:

Siddharth-routによって投稿されたコードで「ユーザー定義型が定義されていません」というエラーが発生しました

「Microsoft Forms 2.0 Object Library」ライブラリが見つからない/アクティブ化されていないことが判明.

これで動作するようになりました( http://Excel-macro.tutorialhorizo​​n.com/vba-Excel-reference-libraries-in-Excel-workbook/ ):

「リストに必要な参照が見つからない場合があります。その場合、system32からFM20.DLLファイルを参照する必要があるため、ツール/参照リストに「Microsoft Forms 2.0 Object Library」が見つからないとします。」

5
Leon Wurr

次のコードをb4だけを追加して、デバッグ用の改行を追加します。そのエラーは、テスト後に消えました。

myString = DataObj.GetText(1)
MsgBox myString
0
agadir