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

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

Office / VBAの勉強が思うように進まないときは!

Office / VBAの勉強が思うように進まないのであれば、プロに直接質問ができる プログラミングスクール を検討してみてはいかがでしょうか?プログラミングスクールに申し込めば、短期間で一定のスキルを身に着けることができます!

Office / VBAコースあり!未経験者にウケてる KENスクール パソコンスクール・パソコン教室 【KENスクール】個別指導のWeb-DTP・OA・IT PCスクール

理解度や学習ペースに合わせて、一人ひとりが納得して前進できる授業を提供してくれるのが特徴です。特に課題製作は現場さながらで、実務に即したものとなっていますので短期でのスキルアップが望めます。自宅学習のサポートも充実していて、授業内容をいつでもビデオで振り返ることができるのもうれしいですね。好きな時間に好きな場所で、無理なくスケジューリングできるので、仕事の忙しい方でも柔軟に学ぶことができますよ。

更にさらに、なんと 就職サポート をしてくれるというのですから驚きです!!

履歴書の書き方から面接指導、求人の紹介など、具体的な就職先まで提案してくれるんです!私も「もっと早く出会いたかったなぁー、こんなスクール」・・・って思っちゃいました^^

東京・神奈川・愛知・大阪を営業エリアとされています。
まずは気軽に 無料体験予約 に申し込んでみるのもアリですよ。


コメントを残す

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

コメント(必須)

Trackback URL