Excel VBA テキストボックス クリップボードへコピー

  • デル株式会社
  • テキストボックス クリップボードへコピー

    Excel VBA でテキストのコピペツールみたいなの作ったので、
    書いてみる。

    基本編

    UserForm 内容は、実行ボタンとテキストボックス
    こんな感じ。

    ソース

    
    '**********************************
    'VBAの実行結果には、責任取りません。
    '使用時は自己責任でお願いします。
    '**********************************
    
    Private Sub CommandButton1_Click()
        
        With TextBox1 'テキストボックスのオブジェクト名
            
            .MultiLine = True         '複数行の場合に、Trueを設定する。1行なら不要
            .SelStart = 0             'コピーするテキストの先頭位置
            .SelLength = .TextLength  'コピーする文字数
            .Copy                     'コピーメソッド
        
        End With
        
    End Sub
    

    VBA実行後、ボタンをクリックすると、テキストボックスの内容が、
    クリップボードへコピーされます。
    この後、Ctrl + v で貼り付け。



    応用編1

    基本編の応用で、動的にTextBoxを作成して、クリップボードへコピーします。
    (以前は、DataObject を使ってコピーできたんだけど、今はなぜかできなくなった。なぜ。。)

    
    '**********************************
    'VBAの実行結果には、責任取りません。
    '使用時は自己責任でお願いします。
    '**********************************
    Public Sub TextCopy()
    
        Dim oTextBox As Object
        Dim sText As String
        
        'TextBox作成 Forms.TextBox.1 は ClassID
        Set oTextBox = CreateObject("Forms.TextBox.1")
       
        sText = "クリップボードへコピー"
        
        With oTextBox
           
           .MultiLine = True
           .Text = sText             'TextBoxへコピーする文字列設定
           .SelStart = 0
           .SelLength = .TextLength
           .Copy
        
        End With
        
        Set oTextBox = Nothing
    
    End Sub
    
    

    UserForm は使わないけど、何かをコピーする場合や、
    UserForm にテキストボックスがいっぱいある場合に使用すると幸せかも。

    デル株式会社

    応用編2

    面倒なので、まぁ、たぶん使わないと思うけど、APIを使用する場合を一応書いてみた。
    64bitの場合です。

    32bitの場合は、下記のサイトを参考にする。
    (この記事も参考にしてます。)

    MSサイト:クリップボードに情報を送信する

    
    '**********************************
    'VBAの実行結果には、責任取りません。
    '使用時は自己責任でお願いします。
    '**********************************
    Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As LongLong) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr
    
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    
    Public Sub SetClipboardText()
    
        Dim lphGlobal As LongPtr 'メモリオブジェクトのハンドル
        Dim lpVoid    As LongPtr 'メモリブロックの先頭バイトへのポインタ
        Dim iLen      As Long    '文字列のバイト数
        Dim sText     As String  'クリップボードへコピーする文字列
        
        lphGlobal = 0
        iLen = 0
        lpVoid = 0
        
        'クリップボードへコピーする文字列
        sText = "APIを使用したクリップボードコピー"
        
        
        'クリップボードオープン
        If OpenClipboard(0&) = 0 Then
            
            MsgBox "失敗。他のアプリケーションが開いてる", vbExclamation, "失敗"
        
            Exit Sub
            
        End If
        
        'クリップボードクリアと所有権の割り当て
        If EmptyClipboard = 0 Then
        
            MsgBox "なんだか失敗", vbExclamation, "失敗"
            
            Exit Sub
            
        End If
        
        'サイズ取得
        iLen = LenB(sText) + 2&
        
        'ヒープメモリ割り当て
        lphGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
        
        If lphGlobal = 0 Then
        
            MsgBox "ヒープの割り当てに失敗", vbExclamation, "失敗"
            
            'クリップボードのクローズ
            CloseClipboard
            
            Exit Sub
            
        End If
        
        'メモリブロックのロック
        lpVoid = GlobalLock(lphGlobal)
        
        If lpVoid = 0 Then
        
            MsgBox "メモリロックに失敗", vbExclamation, "失敗"
            
            'クリップボードのクローズ
            CloseClipboard
            
            Exit Sub
        
        End If
        
        '文字列のコピー
        If lstrcpy(lpVoid, StrPtr(sText)) = 0 Then
        
            MsgBox "文字列のコピーに失敗", vbExclamation, "失敗"
            
            'メモリブロックのロック解除
            GlobalUnlock lphGlobal
                    
            'クリップボードのクローズ
            CloseClipboard
            
            Exit Sub
        
        End If
        
        'メモリブロックのロック解除
        GlobalUnlock lphGlobal
            
        'クリップボードへ文字列設定
        If SetClipboardData(CF_UNICODETEXT, lphGlobal) = 0 Then
            
            MsgBox "クリップボードへの文字列設定失敗", vbExclamation, "失敗"
            
            'クリップボードのクローズ
            CloseClipboard
            
            Exit Sub
        
        End If
        
        'クリップボードのクローズ
        CloseClipboard
       
        MsgBox "クリップボードへの文字列設定が成功しました。", vbInformation, "成功"
    
    End Sub
    
    

    ホント面倒。



    おまけ

    おまけ。
    C#では、

    private void button1_Click(object sender, EventArgs e)
    {
        Clipboard.SetText("C#で文字列をクリップボードへ設定します。");
    
           ver sStr = Clipboard.GetText(); 
    }
    

    VC(MFC)では、VC(MFC) クリップボード へ テキスト設定 です。

    関連記事

    ページ上部へ戻る