Drag and Drop mode

Jaafar Tribak · May 4, 2011

Is there a VBA way to detect if the user is currently dragging and dropping a range from one location to another ? I want to be able to trap this event .

Jaafar Tribak · May 5, 2011

No luck so far.

Excel does know when the user is performing a drag and drop a operation because the Statusbar text gets updated. However this event isn't exposed to the programmer. Is anybody aware of a workaround that's worked before ?

Jaafar Tribak · May 10, 2011

Workbook demo.

I have written this small ActiveX dll and have stored its bytes in a hidden worksheet (DllBytes) within the workbook so that the dll can be loaded on the fly upon opening the workbook.

No registration of the dll is required as it is loaded with DirectCom which should make the whole process quicker and work even if the user has no rights to register dlls the conventional way.

The only one requirement for this to work is that the OnCell_Drop event Procedure MUST be Public and located in the Workbook Module so it can be seen by the dll.

In keeping with the office built-in events signature,the On_CellDrop event provides a ByRef Cancel argument to give the user the flexibility to abort the drag and drop operation.

Place this code in the workbook module, save the workbook, reopen it and see if Dragging and Dropping cells are being trapped :

Code:

Option Explicit
 
Private Const JAAFAR_DLL_PATH_NAME As String _
= "C:\DragAndDropWatcher.dll"
[COLOR=Green]
[/COLOR] [COLOR=Green]'CreateObject-Replacement (FileBased)[/COLOR]
Private Declare Function GETINSTANCE Lib "DirectCom" _
(FName As String, ClassName As String) As Object

Private Declare Function UNLOADCOMDLL Lib "DirectCom" _
(FName As String, ClassName As String) As Long

Private oDragAndDropInstance As Object


[COLOR=Green]'=================================================================[/COLOR]
[COLOR=Green]'Drag and Drop custom event.[/COLOR]
[COLOR=Green]'Event Procedure Must be PUBLIC !!! and located in the workbook module.
'Use the ByRef Cancel argument to prevent the drop operation.[/COLOR]

Public Sub OnCellDrop _
(ByVal Source As Range, ByVal Target As Range, ByRef Cancel As Boolean)

    MsgBox "You are trying to drag the Range : " & Source.Address & _
    vbNewLine & " onto the Range : " & Target.Address & vbNewLine _
    & vbNewLine & "This Action is not permitted.", vbCritical
    
    Cancel = True

End Sub
[COLOR=Green]'=====================================================================[/COLOR]


Private Sub Workbook_Open()

    Call CreateDlls

       [COLOR=Green] 'load an instance of the 'DragAndDropWatcher.dll' Class.[/COLOR]
        Set oDragAndDropInstance = _
        GETINSTANCE(JAAFAR_DLL_PATH_NAME, "DragAndDropClass")
        DoEvents

        If Not oDragAndDropInstance Is Nothing Then
           [COLOR=Green] 'start watching the Drop and Drag operations.[/COLOR]
            Call oDragAndDropInstance.Start(ThisWorkbook)
        Else
            MsgBox "Unable to load the " & _
            "'DragAndDropWatcher' dll.", vbInformation
        End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  [COLOR=Green]  'CleanUp.[/COLOR]

    If Not oDragAndDropInstance Is Nothing Then
        oDragAndDropInstance.Finish
        Set oDragAndDropInstance = Nothing
    End If
    
    UNLOADCOMDLL JAAFAR_DLL_PATH_NAME, "DragAndDropClass"
    
    If Len(Dir(JAAFAR_DLL_PATH_NAME)) <> 0 Then
        Kill JAAFAR_DLL_PATH_NAME
    End If

End Sub



[COLOR=Green]'Create the 'DragAndDropWatcher' dll from the
'Bytes stored in the '"DllBytes" hidden worksheet.[/COLOR]
Private Sub CreateDlls()
 
    Dim bytes() As Byte
    Dim lFileNum As Integer
    Dim aVar
    Dim x As Long
 
    On Error Resume Next
    
 
    With Worksheets("DllBytes")
        aVar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
    End With
  
    ReDim bytes(LBound(aVar) To UBound(aVar))
    For x = LBound(aVar) To UBound(aVar)
        bytes(x) = CByte(aVar(x, 1))
    Next
 
    lFileNum = FreeFile
    Open JAAFAR_DLL_PATH_NAME For Binary As #lFileNum
        Put #lFileNum, 1, bytes
    Close lFileNum

End Sub

Tested on XL 2007 Win 7

Jaafar Tribak · May 10, 2011

For future reference,in case the above workbook demo link has expired, here are the dll bytes that are stored in the DllBytes hidden worksheet in Column A:A :

Code:

Jaafar Tribak · May 10, 2011

Has anybody tested the workbook and noticed any problems ? would appreciate some feedback before taking this any further.

Jaafar Tribak · May 10, 2011

Jaafar Tribak said:
Has anybody tested the workbook and noticed any problems ? would appreciate some feedback before taking this any further.

Bump.

John_w · May 11, 2011

Nice one - very clever.

It works fine on Excel 2003 and Windows XP, after the following initial setup trouble:

I downloaded your demo workbook and upon opening it got a 'Run-time error 53. File not found: DIRECTcom' message. I downloaded RichClient-Toolset binaries from http://www.thecommon.net/3.html and extracted DirectCOM.dll to C:\Windows\System32. This was needed because you have the following in the demo workbook but not in the posted code:

Code:

Private Const DCOM_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DirectCOM.dll"

Jaafar Tribak · May 12, 2011

Thanks John for looking into this and glad it worked for you.

This was needed because you have the following in the demo workbook but not in the posted code:

Thanks for bringing this problem to my attention. I forgot to include the DirectCom bytes in the code. fortunately, being a small dll (under 20 kbs) ,I stored its bytes in the workbook as well.

Hopefully, the code below should now work without the need of any dll registration and more importantly without fearing of crashing the application: (dll bytes are stored in the 'DllBytes' hidden worksheet)

Workbook demo.

Code update (goes in the workbook module):

Code:

Option Explicit
 
Private Const DCOM_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DirectCOM.dll"
 
Private Const JAAFAR_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DragAndDropWatcher.dll"

'CreateObject-Replacement (FileBased)
Private Declare Function GETINSTANCE Lib "DirectCom" _
(FName As String, ClassName As String) As Object

Private Declare Function UNLOADCOMDLL Lib "DirectCom" _
(FName As String, ClassName As String) As Long

Private oDragAndDropInstance As Object


'=================================================================
'Drag and Drop custom event.
'Event Procedure Must be PUBLIC !!! and located in the workbook module.
'Use the ByRef Cancel argument to prevent the drop operation.

Public Sub OnCellDrop _
(ByVal Source As Range, ByVal Target As Range, ByRef Cancel As Boolean)

    MsgBox "You are trying to drag the Range : " & Source.Address & _
    vbNewLine & " onto the Range : " & Target.Address & vbNewLine _
    & vbNewLine & "This Action is not permitted.", vbCritical
    
    Cancel = True

End Sub
'=====================================================================


Private Sub Workbook_Open()

        'Create the DirectCom & DragAndDropWatcher dlls.
        Call CreateDlls
        
        'load an instance of the 'DragAndDropWatcher.dll' Class.
        Set oDragAndDropInstance = _
        GETINSTANCE(JAAFAR_DLL_PATH_NAME, "DragAndDropClass")
        DoEvents

        If Not oDragAndDropInstance Is Nothing Then
            'start watching the Drop and Drag operations.
            Call oDragAndDropInstance.Start(ThisWorkbook)
        Else
            MsgBox "Unable to load the " & _
            "'DragAndDropWatcher' dll.", vbInformation
        End If
''
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    
    If Not oDragAndDropInstance Is Nothing Then
        oDragAndDropInstance.Finish
        Set oDragAndDropInstance = Nothing
    End If
    
    UNLOADCOMDLL JAAFAR_DLL_PATH_NAME, "DragAndDropClass"

End Sub



'Create the 'DragAndDropWatcher' dll from the
'Bytes stored in the '"DllBytes" hidden worksheet.
Private Sub CreateDlls()
 
    Dim Bytes() As Byte
    Dim lFileNum As Integer
    Dim aVar
    Dim x As Long
 
    On Error Resume Next
    
    If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then
    
       With Worksheets("DllBytes")
           aVar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
       End With
     
       ReDim Bytes(LBound(aVar) To UBound(aVar))
       For x = LBound(aVar) To UBound(aVar)
           Bytes(x) = CByte(aVar(x, 1))
       Next
    
       lFileNum = FreeFile
       Open JAAFAR_DLL_PATH_NAME For Binary As #lFileNum
           Put #lFileNum, 1, Bytes
       Close lFileNum
    
    End If
    

    If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then
    
        Erase Bytes
        
        With Worksheets("dllBytes")
            aVar = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
        End With
        
        ReDim Bytes(LBound(aVar) To UBound(aVar))
        For x = LBound(aVar) To UBound(aVar)
            Bytes(x) = CByte(aVar(x, 1))
        Next
        lFileNum = FreeFile
        Open DCOM_DLL_PATH_NAME For Binary As #lFileNum
            Put #lFileNum, 1, Bytes
        Close lFileNum
        
    End If
    

End Sub

John_w · May 12, 2011

DragAndDrop2.xls from the latest workbook demo works perfectly now.

The only thing I noticed is that your DirectCOM.dll is 20 KB, whereas DirectCOM.dll from http://www.thecommon.net/3.html is 23 KB. Maybe you have an earlier version.

Jaafar Tribak · May 12, 2011

John_w said:
DragAndDrop2.xls from the latest workbook demo works perfectly now.

The only thing I noticed is that your DirectCOM.dll is 20 KB, whereas DirectCOM.dll from http://www.thecommon.net/3.html is 23 KB. Maybe you have an earlier version.

I downloaded it some time ago from somewhere I can't remember. I guess it is an ealier version but is good enough for the task of loading dlls without having to pre-register them.

Drag and Drop mode

Jaafar Tribak

Well-known Member

Excel Facts

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

John_w

MrExcel MVP

Jaafar Tribak

Well-known Member

John_w

MrExcel MVP

Jaafar Tribak

Well-known Member

Similar threads

Forum statistics

Share this page

Drag and Drop mode

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock