CellDragAndDrop & Paste buffer

B

BallGazer

Board Regular
Joined
Jul 16, 2008
Messages
110
Hi Guys

Does anyone know how I can disable Drag/drop without emptying the clipboard on sheet/workbook change?

Any help greatly appreciated.

Regards

BG
:confused:
 
Sort by date Sort by votes
@hadihakimzadeh

See if this works for you :

The code assumes Sheet1 is the sheet where CellDragAndDrop is disabled... Change as required.

Code in the Thisworkbook Module

VBA Code: 
Option Explicit

Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If

'Change this Const as required.
Const SHEET_WHERE_DRAG_N_DROP_IS_DISABLED = "Sheet1"

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDrafAndDrop = Not (Wb Is ThisWorkbook And ActiveSheet Is Sheets(SHEET_WHERE_DRAG_N_DROP_IS_DISABLED))
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableCellDrafAndDrop = Not (Sh Is Sheets(SHEET_WHERE_DRAG_N_DROP_IS_DISABLED))
End Sub

Private Property Let EnableCellDrafAndDrop(ByVal Enable As Boolean)
    On Error GoTo CloseClipbrd
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
CloseClipbrd:
    Call CloseClipboard
End Property
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
BallGazer said:
Jon

Thank you for your suggestion. Unfortunately I need Drag/Drop enabled on most of the other sheets. I could adopt your suggestion and activate on all the other sheets. However I am approching 50 sheets now and this is quite a task.

By careful use of the change event I can get close to what I need. Drag/Drop becomes disabled after the first change. As long as the user doesn't make an illegal "drag" the first change I can avoid them screwing up the logic on this sheet. Its far from ideal but does work somewhat.

Once again many thanks

BG
Click to expand...
Please can I see your code for this? I wouldn't mind this solution at all. Thank you.
 
Upvote 0
Jaafar Tribak said:
@hadihakimzadeh

See if this works for you :

The code assumes Sheet1 is the sheet where CellDragAndDrop is disabled... Change as required.

Code in the Thisworkbook Module

VBA Code: 
Option Explicit

Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If

'Change this Const as required.
Const SHEET_WHERE_DRAG_N_DROP_IS_DISABLED = "Sheet1"

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDrafAndDrop = Not (Wb Is ThisWorkbook And ActiveSheet Is Sheets(SHEET_WHERE_DRAG_N_DROP_IS_DISABLED))
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableCellDrafAndDrop = Not (Sh Is Sheets(SHEET_WHERE_DRAG_N_DROP_IS_DISABLED))
End Sub

Private Property Let EnableCellDrafAndDrop(ByVal Enable As Boolean)
    On Error GoTo CloseClipbrd
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
CloseClipbrd:
    Call CloseClipboard
End Property
Click to expand...
Hi, Thanks for this Alternative solution, but is it possible to have this code work for all the sheets in the workbook?
 
Upvote 0
TH_AjeTs said:
Hi, Thanks for this Alternative solution, but is it possible to have this code work for all the sheets in the workbook?
Click to expand...
Are you using just one workbook ?
If so, just disable the application CellDragAndDrop Property manually via the User Interface... You don't need code.
 
Upvote 0
Jaafar Tribak said:
Are you using just one workbook ?
If so, just disable the application CellDragAndDrop Property manually via the User Interface... You don't need code.
Click to expand...
VBA Code: 
Option Explicit
Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If

'Change this Const as required.
Const DNDSheet = "CONFIG"

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Select Case Application.CutCopyMode
Case Is = False
'do nothing
Case Is = xlCopy
'do nothing
Case Is = xlCut
MsgBox "Please do NOT Cut and Paste. Use Copy and Paste; then delete the source."
Application.CutCopyMode = False 'clear clipboard and cancel cut
End Select

End Sub

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDragAndDrop = Not (Wb Is ThisWorkbook And ActiveSheet Is Sheets(DNDSheet))
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    EnableCellDragAndDrop = Not (Sh Is Sheets(DNDSheet))
End Sub

Private Property Let EnableCellDragAndDrop(ByVal Enable As Boolean)
    On Error GoTo clipboardC
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
clipboardC:
    Call CloseClipboard
End Property

Please I am a VBA noob. I just copy and paste solutions online and try to use common-sense to tweak it into doing what I want. That being said, I can't figure out how to make this code work for the entire workbook. Right now it works for just the "Config" sheet. Code is also a little slow...takes about a second or two to resolve when I activate the workbook that I want to paste data in.
And yes, I'm using this code for just that one workbook. I don't want the code disabling drag and drop across other excel workbooks open, but I want the whole thing to be automatic & foolproof. lol

Thanks in advance
 
Upvote 0
Try this:
VBA Code: 
Option Explicit

Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Select Case Application.CutCopyMode
        Case Is = False
            'do nothing
        Case Is = xlCopy
            'do nothing
        Case Is = xlCut
            MsgBox "Please do NOT Cut and Paste. Use Copy and Paste; then delete the source."
            Application.CutCopyMode = False 'clear clipboard and cancel cut
    End Select
End Sub

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDragAndDrop = Not (Wb Is ThisWorkbook)
End Sub

Private Property Let EnableCellDragAndDrop(ByVal Enable As Boolean)
    On Error GoTo clipboardC
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
clipboardC:
    Call CloseClipboard
End Property

"Code is also a little slow...takes about a second or two to resolve when I activate the workbook that I want to paste data in."
I can't do anything about that I am afraid.
 
Upvote 0
Jaafar Tribak said:
Try this:
VBA Code: 
Option Explicit

Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Select Case Application.CutCopyMode
        Case Is = False
            'do nothing
        Case Is = xlCopy
            'do nothing
        Case Is = xlCut
            MsgBox "Please do NOT Cut and Paste. Use Copy and Paste; then delete the source."
            Application.CutCopyMode = False 'clear clipboard and cancel cut
    End Select
End Sub

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDragAndDrop = Not (Wb Is ThisWorkbook)
End Sub

Private Property Let EnableCellDragAndDrop(ByVal Enable As Boolean)
    On Error GoTo clipboardC
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
clipboardC:
    Call CloseClipboard
End Property

"Code is also a little slow...takes about a second or two to resolve when I activate the workbook that I want to paste data in."
I can't do anything about that I am afraid.
Click to expand...
Thank you so much. This works quite nicely. I added some other code to wipe the clipboard on exit tho, because I didn't want the notifications that showed after I exited the file, having done lots of copy & paste actions.
This is the final code. If there are any needed optimizations, feel free to let me know. I wasn't able to use the declarations in one place...so I had to do it in another module for the Clearclipboard function.
This code is in a separate module -
VBA Code: 
Option Explicit
#If VBA7 Then
    '64 bit declares here
    Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
    Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
#Else
    '32 bit declares here
    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function EmptyClipboard Lib "user32" () As Long
    Public Declare Function CloseClipboard Lib "user32" () As Long
#End If

Public Function ClearClipboard()
  OpenClipboard (0&)
  EmptyClipboard
  CloseClipboard
End Function

This next code is in the ThisWorkbook module -
Code: 
Option Explicit
Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDragAndDrop = Not (Wb Is ThisWorkbook)
End Sub

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

Private Property Let EnableCellDragAndDrop(ByVal Enable As Boolean)
    On Error GoTo clipboardC
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
clipboardC:
    Call CloseClipboard
End Property

Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Select Case Application.CutCopyMode
Case Is = False
'do nothing
Case Is = xlCopy
'do nothing
Case Is = xlCut
MsgBox "Please do NOT Cut and Paste. Use Copy and Paste; then delete the source."
Application.CutCopyMode = False
End Select

End Sub
Thanks again.
 
Upvote 0
You can keep the entire code in the ThisWorkbook Module without the need for a seperate one.

Like this :
VBA Code: 
Option Explicit

Private WithEvents AppEvents As Application

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
#End If

Private Sub Workbook_Activate()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookActivate(ByVal Wb As Workbook)
    EnableCellDragAndDrop = Not (Wb Is ThisWorkbook)
End Sub

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

Private Sub Workbook_Deactivate()
    Application.CellDragAndDrop = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Select Case Application.CutCopyMode
        Case Is = False
        'do nothing
            Case Is = xlCopy
            'do nothing
        Case Is = xlCut
            MsgBox "Please do NOT Cut and Paste. Use Copy and Paste; then delete the source."
            Application.CutCopyMode = False
    End Select
End Sub

Private Function ClearClipboard()
  OpenClipboard (0&)
  EmptyClipboard
  CloseClipboard
End Function

Private Property Let EnableCellDragAndDrop(ByVal Enable As Boolean)
    On Error GoTo clipboardC
    Call OpenClipboard(Application.hwnd)
    Application.CellDragAndDrop = Enable
clipboardC:
    Call CloseClipboard
End Property
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Clipboard Error
Replies
2
Views
622
mskli
M
S
  • Solved
Removing trailing space when pasting copied information from cell text copied
Replies
6
Views
292
Alex Blakenburg
A
KlausW
  • Solved
copy data from several closed workbooks to one workbook.
Replies
5
Views
783
KlausW
KlausW
K
  • Question
Help with VB Code to copy workbook
Replies
0
Views
219
kizzie37
K
KlausW
  • Question
browse to folders and subfolders an copy cell
Replies
0
Views
234
KlausW
KlausW

Forum statistics

Threads
1,216,116
Messages
6,128,926
Members
449,479
Latest member
nana abanyin

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