VBA コピーされたセル範囲を取得する方法 - Excel

まず 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 では２通りのセル形式があります。機械が判別しやすい 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

テストしてみるとこんな感じです。セル範囲がコピーされているのがわかりますね。

### コピーされたセル ###
R1C1形式: R1C1:R5C3
A1形式: $A$1:$C$5

Excel VBAでコピーされたセル範囲をRange型で取得する方法を紹介しました。

これを利用すると特定のセルではコピペを禁止したりと、様々なことに活用できるのではないでしょうか。Excel VBAで作られた社内ツールは多いでしょうから使われる方の年代も様々でしょう。うまく活用して不要なコピペがおこなわれないよう制御できるといいですね。