< DELETE 文の複合テーブル構文 | Windows Media エンコード スクリプトで一括エンコード >

November 1, 2010

VBA よりクリップボードにアクセスする

Excel VBA よりクリップボードに文字列を設定したくて、Microsoft Forms 2.0 Object Library のDataObject を使ってたんですけど、なぜか全くクリップボードが更新されず。先日の WSH 用の Tips を VBA に移植してみました。Excel 2003 SP3 + IE8 では動作してます。

Option Explicit

'' コマンドID
Private Enum OLECMDID
    OLECMDID_COPY = 12&
    OLECMDID_PASTE = 13&
    OLECMDID_SELECTALL = 17&
End Enum

'' IE のインスタンス
Private internetExplorer_ As Object

'' テキストエリア
Private textArea_ As Object

'' クリップボードに文字列をセットする
Public Sub SetText(text As String)
On Error GoTo ErrHandler:
    '' TEXTAREA に文字列をセット
    textArea_.innerText = text
    '' すべてを選択
    Call internetExplorer_.ExecWB(OLECMDID_SELECTALL, 0)
    '' コピー
    Call internetExplorer_.ExecWB(OLECMDID_COPY, 0)

    Exit Sub
ErrHandler:
    Call Err.Raise(Err.Number, "Clipboard.SetText()" & " ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Sub

'' クリップボードより文字列を取得する
Public Function GetText() As String
On Error GoTo ErrHandler:
    '' TEXTAREA の初期化
    textArea_.innerText = ""

    '' ペーストコマンド
    Call textArea_.ExecWB(OLECMDID_PASTE, 0)

    '' TEXTAREA の文字列を取得する
    GetText = textArea_.innerText

    Exit Function
ErrHandler:
    Call Err.Raise(Err.Number, "Clipboard.GetText()" & " ← " & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)

End Function

'' クラス初期化処理
Private Sub Class_Initialize()
On Error GoTo ErrHandler:

    '' IE を起動する
    Set internetExplorer_ = CreateObject("InternetExplorer.Application")
    Call internetExplorer_.Navigate("about:blank")

    '' 安定するまで待つ
    Do While internetExplorer_.Busy
    Loop

    '' TEXTAREA 要素を作成する
    Set textArea_ = internetExplorer_.document.createElement("textarea")
    Call internetExplorer_.document.body.appendChild(textArea_)

    '' フォーカスを与えておく
    Call textArea_.Focus

ExitHandler:
    Exit Sub

ErrHandler:
    Call MsgBox(Err.Number & ":" & Err.Source & vbLf & Err.Description, vbCritical, "エラー")
    Resume ExitHandler

End Sub

'' クラス破棄時処理
Private Sub Class_Terminate()

On Error Resume Next

    ' IE が起動していれば終了させる
    If (Not internetExplorer_ Is Nothing) Then
        internetExplorer_.Quit
    End If

End Sub

トラックバック

このエントリーにトラックバック:
http://frog.raindrop.jp/cgi-bin/mt/mt-tb.cgi/2574

コメント

こんにちはこのウェブページに新しいIMと私はこんにちは言うと思った。これは偉大なウェブサイトと私が参加したIM喜んですることができます。歓迎このブログのおかげで新しい。私はちょうどこの素晴らしいブログに来て、皆に自分自身を紹介したい。これは本当にそのような優秀なインターネットサイトです。

コメントする

※ コメントスパム対策のため、コメント本文はおはよう、こんにちわ、こんばんわのいずれかより始めるようにしてください。

name:
email:

※ 必要ですが、表示しません。

url:
情報を保存する ?