VBA コピーされたセル範囲を取得する方法 - Excel
VBAでコピーされたセル範囲を取得する方法です。
Excel VBAには、コピーイベントがありません。コピーしたセル範囲を取得するには、Worksheet_SelectionChange
イベントと API
を利用する必要があります。
つまり、コピーした時にアドレスを取得するのではなく、コピーされた後セル移動された時にアドレスを取得することになります。
コピーした後移動ということは、ペースト先へ移動(中)と考えるべきでしょう。
これが思ったより手間だったんですよねー。
ここでは Excel VBAでコピーされたセル範囲をRange型で取得する方法 を紹介します。Sponsored Links
サンプルソース
まず API を使ってコピー元のセル範囲を取得します。以下のサンプルを利用するとアドレスが取得できます。標準モジュールを追加して以下のソースをコピぺしてください。
Option Explicit Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long '** ' コピーアドレスの取得 '** Public Function GetCopyAddress(SheetName As String) As String Dim i As Long Dim Format As Long Dim hMem As Long Dim p As Long Dim Data() As Byte Dim Size As Long Dim Address As String Call OpenClipboard(0) hMem = GetClipboardData(RegisterClipboardFormat("Link")) If hMem = 0 Then Call CloseClipboard Exit Function End If Size = GlobalSize(hMem) p = GlobalLock(hMem) ReDim Data(0 To Size - 1) Call MoveMemory(VarPtr(Data(0)), p, Size) Call GlobalUnlock(hMem) Call CloseClipboard For i = 0 To Size - 1 If Data(i) = 0 Then Data(i) = Asc(" ") End If Next i GetCopyAddress = Trim(Replace(AnsiToUnicode(Data()), "Excel " & ThisWorkbook.Path & "[" & ThisWorkbook.Name & "]" & SheetName & " ", "")) End Function '** ' Unicode変換 '** Private Function AnsiToUnicode(ByRef Ansi() As Byte) As String On Error GoTo ErrHandler Dim Size As Long Dim Buf As String Dim BufLen As Long Dim RtnLen As Long Size = UBound(Ansi) + 1 BufLen = Size * 2 + 10 Buf = String$(BufLen, vbNullChar) RtnLen = MultiByteToWideChar(0, 0, Ansi(0), Size, StrPtr(Buf), BufLen) If RtnLen > 0 Then AnsiToUnicode = Left$(Buf, RtnLen) End If ErrHandler: End Function
次に Worksheet_SelectionChange
イベントで Application.CutCopyMode
がコピーの場合、上記の関数からコピー元のセル範囲を取得します。
VBA では2通りのセル形式があります。機械が判別しやすい Cells
型と、人間が判別しやすい Range
型です。Cells
型は R1C1 形式 と呼ばれており、Range
型は A1 形式 と呼ばれています。
R1C1 形式 から A1 形式 に変換するには Application.ConvertFormula
を使います。
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim CopyRange As Range Dim Cells As String ' コピーモードの場合 If Application.CutCopyMode = xlCopy Then ' セルを取得 Cells = GetCopyAddress(Me.Name) Debug.Print "### コピーされたセル ###" Debug.Print "R1C1形式: " & Cells ' R1C1形式からA1形式に変換 Set CopyRange = Range(Application.ConvertFormula(Cells, xlR1C1, xlA1)) Debug.Print "A1形式: " & CopyRange.Address End If End Sub
Sponsored Links
テスト
テストしてみるとこんな感じです。セル範囲がコピーされているのがわかりますね。
### コピーされたセル ### R1C1形式: R1C1:R5C3 A1形式: $A$1:$C$5
まとめ
Excel VBAでコピーされたセル範囲をRange型で取得する方法を紹介しました。
これを利用すると特定のセルではコピペを禁止したりと、様々なことに活用できるのではないでしょうか。Excel VBAで作られた社内ツールは多いでしょうから使われる方の年代も様々でしょう。うまく活用して不要なコピペがおこなわれないよう制御できるといいですね。
おつかれさまでした。
Sponsored Links