コピーした文字列を現在開いているシート名にセットしたい

質問

現在開いているシート名を、クリップボードにある（？）文字列に
書き換える（？）マクロをつくりたいです。例えば、

(1) セルA1に、「aaa111」と入力されているとします。
(2) A1セルをダブルクリック（ないし、数式バーから必要な文字列だけを選択）します。
(3) 「111」だけをコピー（Ctrl+C）します。
(4) 「Sheet1」のタブをWクリックします。
(5) 貼り付け（Ctrl+V）により「Sheet1」が「111」に書き換えられます。
(6) Enterキーで確定します。

参考までに今の動作をマクロ記録してみると、次のようになったのですが、
「111」だけをコピーしたつもりなのに、「aaa111」がクリップボードに
格納されてしまっています。

Sub Macro1()
　　ActiveCell.FormulaR1C1 = "aaa111"
　　Sheets("Sheet1").Select
　　Sheets("Sheet1").Name = "111"
End Sub

任意のセルをダブルクリックして
必要な文字列（＝シート名にしたい文字列）だけをコピーし、
マクロを実行（ショートカットキーを押下）するだけで
サッと書き換わるイメージですが、実現可能でしょうか。

よろしくお願い致します。

回答No.2

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

直接シートタブ上で Ctrl＋V として貼り付けても手間は変わらない
と思いますが、あえて VBA でやってみます。

VBA はクリップボード操作の命令が貧弱で、クリップボードのデータ
を直接操作することはできません。

したがって、VBA でクリップボード内のデータを取得するには、

・#1 のご回答のとおり、一度セルを経由させる
・MS Forms2 Object Library を使う
・API の GetClipboardData 関数を使う

のいずれかの方法をとることになります。下記のコードでは API を
使って直接クリップボードの文字列を取得しています。

ご参考までに。

'【標準モジュール】
'// クリップボードを開く
Declare Function OpenClipboard Lib "User32" ( _
　　　　ByVal hWndNewOwner As Long) As Long
'// クリップボードを閉じる
Declare Function CloseClipboard Lib "User32" () As Long
'// クリップボードのデータハンドルを取得する
Declare Function GetClipboardData Lib "User32" ( _
　　　　ByVal wFormat As Long) As Long
'// ヒープに確保されたメモリをロックする
Declare Function GlobalLock Lib "kernel32" ( _
　　　　ByVal hMEM As Long) As Long
'// GlobalLock関数によってロックしたメモリのロックを外す
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" ( _
　　　　ByVal lpString1 As Any, _
　　　　ByVal lpString2 As Any) As Long

'// GetClipboardData wFormat 定数
Public Const CF_TEXT = 1

'// クリップボードから文字列を取り出す
Private Function CP_GetDATA()

　　Dim hCLP　 As Long
　　Dim hMEM　 As Long
　　Dim strBUF As String

　　If OpenClipboard(0&) = 0 Then Exit Function
　　hCLP = GetClipboardData(CF_TEXT)
　　hMEM = GlobalLock(hCLP)

　　On Error GoTo TERMINATE
　　If hMEM <> 0 Then
　　　　strBUF = Space$(GlobalSize(hMEM))
　　　　Call lstrcpy(strBUF, hMEM)
　　　　Call GlobalUnlock(hCLP)
　　　　strBUF = _
　　　　Mid$(strBUF, 1, InStr(strBUF, vbNullChar) - 1)
　　End If

TERMINATE:
　　Call CloseClipboard
　　CP_GetDATA = strBUF
　　On Error GoTo 0

End Function

Sub クリップボードのデータをシート名に()

　　Dim strSHNAME As String

　　On Error Resume Next
　　'一応改行コードをカットしてシート名とできるか
　　'試してみる--＞できなければそのまま終了
　　strSHNAME = CP_GetDATA()
　　strSHNAME = Replace(strSHNAME, vbCrLf, vbLf)
　　strSHNAME = Replace(strSHNAME, vbLf, "")
　　ActiveSheet.Name = strSHNAME
　　On Error GoTo 0

End Sub

お礼

KenKen_SPさん、いつもお世話になってます！

> VBA はクリップボード操作の命令が貧弱で、クリップボードのデータ
> を直接操作することはできません。

キーボードマクロで拾えなかった理由は
そういうことだったのですが。

> ・#1 のご回答のとおり、一度セルを経由させる
> ・MS Forms2 Object Library を使う
> ・API の GetClipboardData 関数を使う

なるほど、VBAの範疇でないことは、よそから
プログラムを借りて解決できるというわけですね。

以前もマクロで質問させていただいたとき、APIを活用した
解法をご教示いただいたことがありました。

> のいずれかの方法をとることになります。下記のコードでは API を
> 使って直接クリップボードの文字列を取得しています。

早速導入させていただきましたが、あまりにも
希望した動作だったので感動しました(^^;

個人用マクロブックに入れて永久保存版にさせていただきますm(_ _)m

> 直接シートタブ上で Ctrl＋V として貼り付けても手間は変わらない

た、確かにそうかもしれませんね。

キーボードから手を離さないで済むだけでも十分に生産性は上がり
ますので、活躍の場はたくさんありそうです。

本当にありがとうございました。今後ともよろしくお願い致します。

回答No.1

komorebi99

思いついたものが、１つセルを経由する（してしまう）コードです
もう少しすっきり作れそうですが、取り急ぎ。

Public Sub CPB_Paste()

CP_Arng = Application.ClipboardFormats

For Each CP_data In CP_Arng
If クリップデータ = xlClipboardFormatText Then
Range("A1").PasteSpecial Operation:=xlPasteAll
Sheets("Sheet1").Name = Range("A1")
Exit For
End If
Next

End Sub

お礼

komorebi99さん、レスありがとうございました。
なるほど、一回セルを経由することで
解決できるわけですね、

ご提示いただいたコードも大変勉強になります。
本当にありがとうございました。