#15 クリップボードをVBAから使う

T'sKitの「コメントブロック」ツールや「イコール式左右交換」ツールなどでは、クリップボードにコピーされたテキストの内容を加工しその結果をクリップボードに書き戻すことでそれらの機能を実現しています。ここでは、これらのツールで利用しているVBAを使ってのクリップボードの操作について説明したいと思います。
 
Accessのフォームの、あるテキストボックスに書き込まれた内容をクリップボードにコピーしたり、逆にクリップボードの内容をテキストボックスに貼り付けたりする場合には、わざわざVBAを使わなくてもマクロで簡単に行うことができます。例えば、"テキスト0"という名前のテキストボックスの内容をクリップボードにコピーする場合、何らかのイベントに次の２つのアクションを実行するマクロを指定すればよいのです。
  • [コントロールの移動]アクション - [コントロール名]"テキスト0"
  • [コマンドの実行]アクション - [コマンド]"コピー"
一方、クリップボードの内容を加工したい場合、通常のアプリケーションであれば、フォーム上に非表示のテキストボックスを配置してそれに加工後のテキストを書き込んだ後、上記の方法でクリップボードにコピーする、という手順も考えられます。

しかし、T'sKitのようなアドインでモジュールのコードをクリップボード経由で加工するとなると少々手順がやっかいになってきます。AccessにはVisualBasicのようにクリップボードの内容を取得したり書き込んだりする関数がないため、WindowsAPIを使う必要があるのです。しかも、順番に複数のWindowsAPIを使わなければなりません。実際にクリップボードからデータを読み込んだり書き込んだりするのは、GetClipboardData関数 や SetClipboardData関数 です。しかしこれらの関数は、返り値をそのままVBAの文字列変数にセットしたり、あるいは文字列変数の値を直接引数として与えることによって書き込めるわけではありません。		 クリップボードのメモリの説明図
例えばクリップボードの内容を読み込む場合、GetClipboardData関数を使ってクリップボードから取得されたテキストデータは「共有グローバルメモリブロック」と呼ばれるメモリ領域にあります。AccessのVBAでそのテキストを通常の文字列変数のデータとして扱うためにはそのメモリの内容をlstrcpy関数を使って「プライベート(ローカル)メモリブロック」という領域に転送する必要があります。そしてクリップボードにデータを書き込む場合には逆の操作を行って、まず「共有グローバルメモリブロック」にデータを転送してから SetClipboardData関数 によってクリップボードに送ります。このように２つの異なるメモリ領域をデータを移動させる初めてVBAでクリップボードのデータを操作することができるのです。
それではここで、このWindowsAPIを使った一連の手順をサンプルプロシージャとして示します。実際に試すには次のコードをまとめて標準モジュールのウィンドウに貼り付けて下さい。

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, _
                     ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                     ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, _
                     ByVal lpString2 As Any) As Long
  ※lstrcpy関数の２つの引数の型は一般的に使われるものと異なり、いずれも"Any型"であることに注意してください。データの読み書き両方に対応するためにはAny型にする必要があります。

Public Const CF_TEXT As Long = 1  'テキストデータを読み書きする場合の定数です


'クリップボードからテキストデータを読み込むプロシージャ
Public Function GetClipText() As String
  Dim lngHwnd As Long, lngMem As Long
  Dim strClipData As String
  Dim lngClipDataLen As Long
  Dim blnErrflg As Boolean
  Dim lngRet As Long

  blnErrflg = True
  'クリップボードをオープン
  If OpenClipboard(0&) <> 0 Then
    'クリップボードのデータを読み込んでメモリブロックのハンドルを取得
    lngHwnd = GetClipboardData(CF_TEXT)
    If Not IsNull(lngHwnd) Then
      'グローバルメモリブロックをロックしてポインタを取得
      '(ロックしないと、他のアプリケーションによってクリップボードが
      '操作された場合にlngHwndの値が無効になってしまう)
      lngMem = GlobalLock(lngHwnd)
      If Not IsNull(lngMem) Then
        lngClipDataLen = GlobalSize(lngHwnd)
        'テキストデータ受け取り用の変数を初期化
        strClipData = String(lngClipDataLen + 1, 0)
        'グローバルメモリブロックの内容をプライベートメモリ領域にコピー
        If lstrcpy(strClipData, lngMem) <> 0 Then
          blnErrflg = False
        End If
        'グローバルメモリブロックのロックを解除
        lngRet = GlobalUnlock(lngHwnd)
      End If
    End If
    'クリップボードをクローズ(これはWindowsに制御が
    '戻らないうちにできる限り速やかに行う)
    lngRet = CloseClipboard()
  End If

  If Not blnErrflg Then
    '後続のNullを除去して返り値にセット
    GetClipText = Left$(strClipData, InStr(strClipData, vbNullChar) - 1)
  Else
    MsgBox "エラー"
  End If

End Function


'クリップボードにテキストデータを書き込むプロシージャ
Public Sub SetClipText(strData As String)
  Dim lngHwnd As Long, lngMem As Long
  Dim lngRet As Long
  Dim lngDataLen As Long
  Dim blnErrflg As Boolean
  Const GMEM_MOVEABLE = 2

  blnErrflg = True
  'クリップボードをオープン
  If OpenClipboard(0&) <> 0 Then
    'クリップボードを空にする
    If EmptyClipboard() <> 0 Then
      'グローバルメモリに書き込む領域を確保してそのハンドルを取得
      lngDataLen = LenB(strData) + 1
      lngHwnd = GlobalAlloc(GMEM_MOVEABLE, lngDataLen)
      If lngHwnd <> 0 Then
        'グローバルメモリをロックしてそのポインタを取得
        lngMem = GlobalLock(lngHwnd)
        If lngMem <> 0 Then
          '書き込むテキストをグローバルメモリにコピー
          If lstrcpy(lngMem, strData) <> 0 Then
            'クリップボードにメモリブロックのデータを書き込み
            lngRet = SetClipboardData(CF_TEXT, lngHwnd)
            blnErrflg = False
          End If
          'グローバルメモリブロックのロックを解除
          lngRet = GlobalUnlock(lngHwnd)
        End If
      End If
    End If
    'クリップボードをクローズ(これはWindowsに制御が
    '戻らないうちにできる限り速やかに行う)
    lngRet = CloseClipboard()
  End If

  If blnErrflg Then MsgBox "エラー"

End Sub
上記のように、クリップボードを操作するVBAのコードはちょっと複雑になってしまいましたが、これらのプロシージャを呼び出して利用するのは簡単です。ここで上記２つのプロシージャの利用例として、T'sKitの「コメントブロック」ツールで行っているような、VBAコードの各行の先頭にクォーテーション(') を付ける例を紹介します。
  • 次のサンプルコードはあくまでもクリップボードの内容をクォーテーション(')を付けて更新するだけものです。コピーや貼り付けはマニュアルで行う必要があります。

  • 更新後のクリップボードの内容をVBAのコードから直接モジュールに貼り付けることはできません。たとえ貼り付け先のモジュールにあるプロシージャが呼び出されなくても、VBAにしてみればその実行中に自分自身を編集する行為となるからです。これはアドイン側から行う場合も同様です。作成中のデータベースのモジュールもアドイン内のモジュールも、区別なく同じメモリ領域上のVBAコードとして扱われるからです。

Sub Test()
  Dim strClip As String
  Dim strNewText As String
  Dim blnLFflg As Boolean
  Dim iintLoop As Integer

  'クリップボードからテキストデータを取得します
  strClip = GetClipText()

  strNewText = ""
  blnLFflg = True
  'テキストデータを１文字ずつ処理
  For iintLoop = 1 To Len(strClip)
    'blnLFflgが"True"のとき、行の先頭と判断して
    'クォーテーション(')を付けます
    If blnLFflg Then
      strNewText = strNewText & "'"
      blnLFflg = False
    End If
    'クリップボードの１文字をstrNewTextに加えます
    strNewText = strNewText & _
                        Mid$(strClip, iintLoop, 1)
    'もし改行コードならblnLFflgを"True"にします
    blnLFflg = (Mid$(strClip, iintLoop, 1) = vbLf)
  Next iintLoop

  '編集されたテキストをクリップボードに書き込みます
  SetClipText strNewText

End Sub
| Index | Prev | Next |

 

Copyright © T'sWare All rights reserved