テキストボックス クリップボードへコピー
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の場合は、下記のサイトを参考にする。
(この記事も参考にしてます。)
'********************************** '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) クリップボード へ テキスト設定 です。