VBA コピーされたセル範囲を取得する方法 - Excel ホームページ制作 | 墨田区

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

LINEで送る
Pocket

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

Excel VBAには、コピーイベントがありません。

コピーしたセル範囲を取得するには、Worksheet_SelectionChange イベントと、API を利用する必要があります。

つまり、コピーした時にアドレスを取得するのではなく、コピーされた後、
セル移動された時に、アドレスを取得することになります。
※コピーした後移動ということは、ペースト先へ移動(中)と考えるべきでしょう。

これが、結構手間だったので、ここに掲載しておきます。




【PR】マジか?!「アレ」してるLINEスタンプっていったい・・・


サンプルソース

まず、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

テスト

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

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

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

おつかれさまでした。

LINEで送る
Pocket

この記事がお役に立ちましたら シェア をお願いいたします。

コメントを残す

コメント(必須)

お名前 (必須)
メールアドレス
(アドレスは公開されません)

Trackback URL