Option Explicit
Private WithEvents cmndbrs As CommandBars
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "user32" () As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function GetClipboardSequenceNumber Lib "user32" () As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call SetCommandBarsHook
End Sub
Private Sub SetCommandBarsHook()
Dim sWBkName As String, sSheetName As String, sRangeAddr As String
If cmndbrs Is Nothing Then
With Application
Call GetFullAddress(sWBkName, sSheetName, sRangeAddr)
Call SetWindowText _
(GetDesktopWindow, Trim(sWBkName & "|" & sSheetName & "|" & sRangeAddr & "|" & GetClipboardSequenceNumber))
Set cmndbrs = .CommandBars
End With
End If
End Sub
Private Sub CmndBrs_OnUpdate()
Dim sCutOrCopiedRangeAddr() As String
Dim sWBkName As String, sSheetName As String, sRangeAddr As String
With Application
If TypeName(.Selection) = "Range" Then
If Len(GetDesktopWndText) Then
sCutOrCopiedRangeAddr = Split(GetDesktopWndText, "|")
If sCutOrCopiedRangeAddr(3) <> GetClipboardSequenceNumber And .CutCopyMode <> 0 Then
Call GetFullAddress(sWBkName, sSheetName, sRangeAddr)
Call SetWindowText(GetDesktopWindow, sWBkName & "|" & sSheetName & "|" & _
sRangeAddr & "|" & GetClipboardSequenceNumber)
sCutOrCopiedRangeAddr = Split(GetDesktopWndText, "|")
End If
End If
End If
End With
End Sub
Private Sub GetFullAddress(ByRef x As String, ByRef y As String, ByRef z As String)
Dim sTemp As String
On Error Resume Next
sTemp = Application.ActiveWindow.RangeSelection.Address(False, False, , True)
x = Left(sTemp, InStr(sTemp, "]") - 1)
x = Replace(x, "[", "")
If Left(x, 1) = "'" Then x = Right(x, Len(x) - 1)
z = Right(sTemp, Len(sTemp) - InStrRev(sTemp, "!"))
y = Replace(Right(sTemp, Len(sTemp) - InStr(sTemp, "]")), z, "")
y = Left(y, Len(y) - 1)
If Right(y, 1) = "'" Then y = Left(y, Len(y) - 1)
End Sub
Public Function GetDesktopWndText() As String
Dim lRet As Long, sBuff As String * 256
lRet = GetWindowText(GetDesktopWindow, sBuff, 256)
GetDesktopWndText = Left(sBuff, 256)
End Function