● クリップボードに文字列を格納する ●

VBの機能ではなく、APIを使用したバージョン。エクセルのマクロあたりで使えるかな?

クリップボードに文字列を格納するだけでたくさんのAPIが必要となる。これを見ると、VB の Clipboard メソッドのありがたみが分かる。

'グローバルメモリのロックを解除する
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

'グローバルメモリをロックする
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long

'グローバルメモリを確保する
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

'グローバルメモリを開放する
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

'文字列をコピー
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long

Private Const GHND = &H42
Private Const CF_TEXT = 1

'クリップボードを開く
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

'クリップボードを空にする
Private Declare Function EmptyClipboard Lib "user32" () As Long

'クリップボードにデータをセットする
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

'クリップボードを閉じる
Private Declare Function CloseClipboard Lib "user32" () As Long

'----------------------------------------------------------------------
' 関数名  :CopyText
' 機能    :クリップボードに文字列を格納する
' 引数    :(i)hWnd … 呼び出したウインドウのハンドル
'           (i)SrcText … クリップボードに格納する文字列
' 返り値  :正常終了:True  異常終了:False
'----------------------------------------------------------------------
Public Function CopyText(ByVal hWnd As Long, ByVal SrcText As String) As Boolean

    Dim FuncRet As Long
    Dim hGlobal As Long
    Dim hLockStrPrt As Long

    'グローバルメモリ領域を確保
    hGlobal = GlobalAlloc(GHND, LenB(StrConv(SrcText, vbFromUnicode)) + Len(Chr$(0)))
    If hGlobal = 0 Then GoTo ErrHandler

    'グローバルメモリ領域をロックし、そのポインタを取得する
    hLockStrPrt = GlobalLock(hGlobal)
    If hLockStrPrt = 0 Then GoTo ErrHandler

    '文字列をグローバルメモリ領域にコピー
    Call lstrcpy(hLockStrPrt, SrcText)

    'グローバルメモリ領域を解除する
    Call GlobalUnlock(hGlobal)

    'クリップボードオープン
    FuncRet = OpenClipboard(hWnd)
    If FuncRet = 0 Then GoTo ErrHandler

    'クリップボードを空にする
    Call EmptyClipboard

    'クリップボードにコピーする
    'SetClipboardData() を実行したら、hGlobal は Windows 側が管理してくれる
    '従って GlobalFree をしなくてよい、というかしてはいけない
    Call SetClipboardData(CF_TEXT, hGlobal)

    'クリップボードを閉じる
    Call CloseClipboard

    CopyText = True
    Exit Function

ErrHandler:
    If hGlobal Then Call GlobalFree(hGlobal)

End Function

戻る