Which Range is currently being Cut or Copied ?

Jaafar Tribak

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,621
Office Version
  1. 2016
Platform
  1. Windows
Hi dear forum members,

I have a vba situation where I need to know the address of the range that is currently being copied (or cut) ie: when Application.CutCopyMode <> 0 .

I wonder if I am overlooking some easy solution or missing something obvious.

Regards.
 
Sort by date Sort by votes
hamiltpj said:
In the project I'm working on, my worksheet_change code causes the marching ants to disappear, so the user can't cut/copy/paste anymore. What I therefore want to do is capture the cut/copy area at the beginning of the handler and then reinstate it at the end.
Click to expand...
Is the initial copying done programmatically or via the UI ?
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
hamiltpj said:
In the project I'm working on, my worksheet_change code causes the marching ants to disappear, so the user can't cut/copy/paste anymore. What I therefore want to do is capture the cut/copy area at the beginning of the handler and then reinstate it at the end.
Click to expand...
In addition to Jaafar's question immediately above this message, I'm interested in what you are doing inside the Change event to make the "marching ants" disappear. The user completing the paste operation does not make them go away nor does having your code assign a value to a cell... so what is it you are doing that does make them go away?
 
Upvote 0
Jaafar - No. I’m just aiming to preserve the original user cut/copy action.

Rick - I’m using the clipboard elsewhere for a hidden copy/paste operation.
 
Upvote 0
Hello Jaafar, just came across this one. I don't have a need at the moment or actually using the code.

But just to bust your balls :)

Would your code work for workbooks in different instances?

Also, why do I feel a need to bookmark all your API based solutions when I come across them? :)

Great work as usual!(y)
 
Upvote 0
Gokhan Aycan said:
Hello Jaafar, just came across this one. I don't have a need at the moment or actually using the code.
But just to bust your balls :)
Would your code work for workbooks in different instances?
Also, why do I feel a need to bookmark all your API based solutions when I come across them? :)
Great work as usual!(y)
Click to expand...
:)
Hi Gokhan

No. The code won't work in different excel instances but you got my interest up and I wrote the following code which uses a different approach.

This should now work for retrieving the range(s) that are currently being cut or copied across all excel instances.

Workbook Demo


1- Here is the code in a Standard Module and run the TEST Sub
VBA Code: 
Option Explicit

 Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type CLIP_INFO
    RangeAddr As String
    CutCopyMode As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
    Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
#End If

Private sRangAddr As String
Private lCCMode As Long
Private WM_MSO_BROADCASTCHANGE As Long


Sub Test()

    Dim uInfo As CLIP_INFO
    Dim sMsg As String
   
    uInfo = GetInfo
   
    With uInfo
        If Len(.RangeAddr) Then
            sMsg = "Clipboard Operation : "
            sMsg = sMsg & IIf(.CutCopyMode = 1, "COPY", "CUT") & vbNewLine
            sMsg = sMsg & "Range in question :  " & .RangeAddr           
                MsgBox sMsg           
        End If
    End With

End Sub



'__________________________________________PUBLIC ROUTINES________________________________________________

Public Property Let EnableClipBoardMonitor(ByVal bEnable As Boolean)

    Const WS_POPUP = &H80000000
    Const GWL_WNDPROC = -4
   
    #If Win64 Then
        Dim hClipMonitor As LongLong, lPrevProc As LongLong
    #Else
        Dim hClipMonitor As Long, lPrevProc As Long
    #End If
   
    If bEnable Then
        If GetProp(hClipMonitor, "hClipMonitor") = 0 Then
            hClipMonitor = CreateWindowEx(0, "Static", "MyClipMonitor", WS_POPUP, 0, 0, 0, 0, 0, 0, GetModuleHandle(vbNullString), 0)
            WM_MSO_BROADCASTCHANGE = RegisterWindowMessage("WM_MSO_BROADCASTCHANGE")
            lPrevProc = SetWindowLong(hClipMonitor, GWL_WNDPROC, AddressOf WinProc)
            Call SetProp(hClipMonitor, "hClipMonitor", hClipMonitor)
            Call SetProp(hClipMonitor, "PrevProc", lPrevProc)
        End If
    Else
        Call CleanUp
    End If

End Property

Public Function GetInfo() As CLIP_INFO

    If Len(sRangAddr) Then
        With GetInfo
            .RangeAddr = sRangAddr
            .CutCopyMode = lCCMode
        End With
    ElseIf FindWindow("Static", "MyClipMonitor") And GetApp.CutCopyMode = 0 Then
        MsgBox "Either there is no range currently being cut or copied OR" & vbNewLine & _
        "the Cut\Copy operation was performed before enabling the ClipboardMonitor routine."
    Else
        MsgBox "The ClipBoardMonitor is not enabled."
    End If

End Function


'__________________________________________PRIVATE ROUTINES________________________________________________

Private Sub CleanUp()

    Const GWL_WNDPROC = -4

    #If Win64 Then
        Dim hClipMonitor As LongLong
    #Else
        Dim hClipMonitor As Long
    #End If

    hClipMonitor = FindWindowEx(0, hClipMonitor, "Static", "MyClipMonitor")
    Do
        hClipMonitor = FindWindowEx(0, 0, "Static", "MyClipMonitor")
        If hClipMonitor = 0 Then
            Exit Do
        Else
            Call SetWindowLong(hClipMonitor, GWL_WNDPROC, GetProp(GetProp(hClipMonitor, "HWND"), "PrevProc"))
            Call RemoveProp(hClipMonitor, "PrevProc")
            Call RemoveProp(hClipMonitor, "HWND")
            Call DestroyWindow(hClipMonitor)
        End If
    Loop
    sRangAddr = vbNullString
    lCCMode = 0

End Sub

Private Function GetApp() As Application

    Const S_OK = &H0&
    Const IID_DISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Const OBJID_NATIVEOM = &HFFFFFFF0
   
    #If Win64 Then
        Dim hXl As LongLong, hDsk As LongLong, hWb As LongLong
    #Else
        Dim hXl As Long, hDsk As Long, hWb As Long
    #End If
   
    Dim oWB As Object
    Dim tGUID(0 To 3) As Long
   
     If Application.CutCopyMode <> False Then
        Set GetApp = Application
        Exit Function
     End If
   
    Do
        hXl = FindWindowEx(0, hXl, "XLMAIN", vbNullString)
        If hXl = 0 Then
            Exit Do
        ElseIf hXl = GetForegroundWindow Then
            hDsk = FindWindowEx(hXl, 0&, "XLDESK", vbNullString)
            hWb = FindWindowEx(hDsk, 0&, "EXCEL7", vbNullString)
            If hWb Then
                If IIDFromString(strPtr(IID_DISPATCH), VarPtr(tGUID(0))) = S_OK Then
                    Call AccessibleObjectFromWindow _
                    (hWb, OBJID_NATIVEOM, VarPtr(tGUID(0)), oWB)
                    Set GetApp = oWB.Application
                    Exit Do
                End If
            End If
        End If
    Loop
 
    Set oWB = Nothing
 
End Function

#If Win64 Then
    Private Function WinProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function WinProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_DESTROY = &H2
   
    Dim sRngAddr As String
    Dim oXL As Application
   
    On Error Resume Next

    Select Case Msg
        Case WM_MSO_BROADCASTCHANGE
            Set oXL = GetApp
            If oXL.CutCopyMode = 0 Then
                sRangAddr = vbNullString
                lCCMode = 0
            Else
                sRngAddr = oXL.ActiveWindow.RangeSelection.Address(, , , True)
                If Len(sRngAddr) Then
                    sRangAddr = sRngAddr
                    lCCMode = oXL.CutCopyMode
                End If
            End If
        Case WM_DESTROY
        Call SetWindowLong(hwnd, GWL_WNDPROC, GetProp(hwnd, "PrevProc"))
    End Select
   
    WinProc = CallWindowProc(GetProp(hwnd, "PrevProc"), hwnd, Msg, wParam, ByVal lParam)

End Function

Private Sub Auto_Close()
   EnableClipBoardMonitor = False
End Sub



2- Code in the ThisWorkbook Module so that the ClipBoard Monitoring routine is up & running upon opening the workbook:
VBA Code: 
Option Explicit

Private Sub Workbook_Activate()
    EnableClipBoardMonitor = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call DisableClipBoardMonitor
End Sub

Private Sub DisableClipBoardMonitor()
    EnableClipBoardMonitor = False
End Sub
 
Upvote 0
Jaafar Tribak said:
:)
Hi Gokhan

No. The code won't work in different excel instances but you got my interest up and I wrote the following code which uses a different approach.

This should now work for retrieving the range(s) that are currently being cut or copied across all excel instances.

Workbook Demo


1- Here is the code in a Standard Module and run the TEST Sub
VBA Code: 
Option Explicit

 Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type CLIP_INFO
    RangeAddr As String
    CutCopyMode As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
    Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
#End If

Private sRangAddr As String
Private lCCMode As Long
Private WM_MSO_BROADCASTCHANGE As Long


Sub Test()

    Dim uInfo As CLIP_INFO
    Dim sMsg As String
  
    uInfo = GetInfo
  
    With uInfo
        If Len(.RangeAddr) Then
            sMsg = "Clipboard Operation : "
            sMsg = sMsg & IIf(.CutCopyMode = 1, "COPY", "CUT") & vbNewLine
            sMsg = sMsg & "Range in question :  " & .RangeAddr          
                MsgBox sMsg          
        End If
    End With

End Sub



'__________________________________________PUBLIC ROUTINES________________________________________________

Public Property Let EnableClipBoardMonitor(ByVal bEnable As Boolean)

    Const WS_POPUP = &H80000000
    Const GWL_WNDPROC = -4
  
    #If Win64 Then
        Dim hClipMonitor As LongLong, lPrevProc As LongLong
    #Else
        Dim hClipMonitor As Long, lPrevProc As Long
    #End If
  
    If bEnable Then
        If GetProp(hClipMonitor, "hClipMonitor") = 0 Then
            hClipMonitor = CreateWindowEx(0, "Static", "MyClipMonitor", WS_POPUP, 0, 0, 0, 0, 0, 0, GetModuleHandle(vbNullString), 0)
            WM_MSO_BROADCASTCHANGE = RegisterWindowMessage("WM_MSO_BROADCASTCHANGE")
            lPrevProc = SetWindowLong(hClipMonitor, GWL_WNDPROC, AddressOf WinProc)
            Call SetProp(hClipMonitor, "hClipMonitor", hClipMonitor)
            Call SetProp(hClipMonitor, "PrevProc", lPrevProc)
        End If
    Else
        Call CleanUp
    End If

End Property

Public Function GetInfo() As CLIP_INFO

    If Len(sRangAddr) Then
        With GetInfo
            .RangeAddr = sRangAddr
            .CutCopyMode = lCCMode
        End With
    ElseIf FindWindow("Static", "MyClipMonitor") And GetApp.CutCopyMode = 0 Then
        MsgBox "Either there is no range currently being cut or copied OR" & vbNewLine & _
        "the Cut\Copy operation was performed before enabling the ClipboardMonitor routine."
    Else
        MsgBox "The ClipBoardMonitor is not enabled."
    End If

End Function


'__________________________________________PRIVATE ROUTINES________________________________________________

Private Sub CleanUp()

    Const GWL_WNDPROC = -4

    #If Win64 Then
        Dim hClipMonitor As LongLong
    #Else
        Dim hClipMonitor As Long
    #End If

    hClipMonitor = FindWindowEx(0, hClipMonitor, "Static", "MyClipMonitor")
    Do
        hClipMonitor = FindWindowEx(0, 0, "Static", "MyClipMonitor")
        If hClipMonitor = 0 Then
            Exit Do
        Else
            Call SetWindowLong(hClipMonitor, GWL_WNDPROC, GetProp(GetProp(hClipMonitor, "HWND"), "PrevProc"))
            Call RemoveProp(hClipMonitor, "PrevProc")
            Call RemoveProp(hClipMonitor, "HWND")
            Call DestroyWindow(hClipMonitor)
        End If
    Loop
    sRangAddr = vbNullString
    lCCMode = 0

End Sub

Private Function GetApp() As Application

    Const S_OK = &H0&
    Const IID_DISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Const OBJID_NATIVEOM = &HFFFFFFF0
  
    #If Win64 Then
        Dim hXl As LongLong, hDsk As LongLong, hWb As LongLong
    #Else
        Dim hXl As Long, hDsk As Long, hWb As Long
    #End If
  
    Dim oWB As Object
    Dim tGUID(0 To 3) As Long
  
     If Application.CutCopyMode <> False Then
        Set GetApp = Application
        Exit Function
     End If
  
    Do
        hXl = FindWindowEx(0, hXl, "XLMAIN", vbNullString)
        If hXl = 0 Then
            Exit Do
        ElseIf hXl = GetForegroundWindow Then
            hDsk = FindWindowEx(hXl, 0&, "XLDESK", vbNullString)
            hWb = FindWindowEx(hDsk, 0&, "EXCEL7", vbNullString)
            If hWb Then
                If IIDFromString(strPtr(IID_DISPATCH), VarPtr(tGUID(0))) = S_OK Then
                    Call AccessibleObjectFromWindow _
                    (hWb, OBJID_NATIVEOM, VarPtr(tGUID(0)), oWB)
                    Set GetApp = oWB.Application
                    Exit Do
                End If
            End If
        End If
    Loop
 
    Set oWB = Nothing
 
End Function

#If Win64 Then
    Private Function WinProc(ByVal hwnd As LongLong, ByVal Msg As Long, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
#Else
    Private Function WinProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

    Const GWL_WNDPROC = -4
    Const WM_DESTROY = &H2
  
    Dim sRngAddr As String
    Dim oXL As Application
  
    On Error Resume Next

    Select Case Msg
        Case WM_MSO_BROADCASTCHANGE
            Set oXL = GetApp
            If oXL.CutCopyMode = 0 Then
                sRangAddr = vbNullString
                lCCMode = 0
            Else
                sRngAddr = oXL.ActiveWindow.RangeSelection.Address(, , , True)
                If Len(sRngAddr) Then
                    sRangAddr = sRngAddr
                    lCCMode = oXL.CutCopyMode
                End If
            End If
        Case WM_DESTROY
        Call SetWindowLong(hwnd, GWL_WNDPROC, GetProp(hwnd, "PrevProc"))
    End Select
  
    WinProc = CallWindowProc(GetProp(hwnd, "PrevProc"), hwnd, Msg, wParam, ByVal lParam)

End Function

Private Sub Auto_Close()
   EnableClipBoardMonitor = False
End Sub



2- Code in the ThisWorkbook Module so that the ClipBoard Monitoring routine is up & running upon opening the workbook:
VBA Code: 
Option Explicit

Private Sub Workbook_Activate()
    EnableClipBoardMonitor = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call DisableClipBoardMonitor
End Sub

Private Sub DisableClipBoardMonitor()
    EnableClipBoardMonitor = False
End Sub
Click to expand...
how could it work in an excel add-ins?
 
Upvote 0
Dear Jaafar, For me, Workbook_SheetSelectionChange method is not workable. I was trying the first method. I copied a range and then run the macro. It does not return the copied range. Everytime this is giving "No range to cut or copy" in MsgBox. So please advise how I can get the copied range with this code.
 
Upvote 0
mohsinbipu said:
Dear Jaafar, For me, Workbook_SheetSelectionChange method is not workable. I was trying the first method. I copied a range and then run the macro. It does not return the copied range. Everytime this is giving "No range to cut or copy" in MsgBox. So please advise how I can get the copied range with this code.
Click to expand...
Hi mohsinbipu

Which code in which post are you using ?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Excel VBA function that cuts a range and pastes it as transpose
Replies
4
Views
467
RoryA
RoryA
G
  • Question
Amend working copy and paste filtered range...to cut and paste instead
Replies
0
Views
310
gazmoz17
G
T
  • Question
Loop through folder and copy data into master spreadsheet
Replies
2
Views
285
TaskMaster
T
J
  • Solved
Copy and Paste
2
Replies
14
Views
762
Anthony47
A
Keebler
  • Solved
new project: copy range without empty or blank rows
5 6 7
Replies
68
Views
1K
Keebler
Keebler

Forum statistics

Threads
1,215,133
Messages
6,123,231
Members
449,091
Latest member
jeremy_bp001

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top