Controlling the ClipBoard

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,577
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am experimenting with some ClipBoard functions at the moment and I am looking to achieve this in XL :

1- How can I prevent the user from copying & pasting graphics & objects? (ie allow ONLY text to be pasted).

2- How can I prevent pasting any Data (Objects or Text) from other applications into XL ? ( But still allow normal Copy & Paste withing XL)

Regards.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
(edited to provide somewhat better code)

I've worked out part of the answer. It involves "intercepting" the paste actions from the keyboard and from the Edit menu and right-click menu.

This will allow you to restrict pasting to just pasting stuff that has been copied from within Excel. I have not worked out how to disable the pasting of graphics/objects that were copied from within Excel - however, you might be able to take the same approach and disable the copying of these objects from within excel by intercepting the copy commands. (Actually I think that should work, just need to figure out how to determine whether the selection is a range or an object/picture.)

Anyway, this goes in the ThisWorkbook code module:


Code:
Option Explicit



Private Sub Workbook_Activate()
    Dim editcontrol As CommandBarControl
    Dim ctrl As CommandBarControl
    Dim rightclick As CommandBar
    
    'Get the Edit menu
    Set editcontrol = Application.CommandBars("Built-in Menus").Controls("Edit")
    
    
    For Each ctrl In editcontrol.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Set a macro to run when this control is clicked/picked
            ctrl.OnAction = "PasteIntercept"
        End If
    Next
    
    'Get the right-click menu when you right-click on a cell
    Set rightclick = Application.CommandBars("Cell")
    
    For Each ctrl In rightclick.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Set a macro to run when this control is clicked/picked
            ctrl.OnAction = "PasteIntercept"
        End If
    Next
    
   'Set up a procedure to run on "CTRL - V" keystroke
   Application.OnKey "^{v}", "PasteIntercept"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim editcontrol As CommandBarControl
    Dim ctrl As CommandBarControl
    Dim rightclick As CommandBar
    
    'Get the Edit menu
    Set editcontrol = Application.CommandBars("Built-in Menus").Controls("Edit")
    
    
    For Each ctrl In editcontrol.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Restore default action
            ctrl.OnAction = ""
        End If
    Next
    
    'Get the right-click menu when you right-click on a cell
    Set rightclick = Application.CommandBars("Cell")
    
    For Each ctrl In rightclick.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Restore default action
            ctrl.OnAction = ""
        End If
    Next
   
   'Restore default action to run on "CTRL - V" keystroke
   Application.OnKey "^{v}"
End Sub


Private Sub Workbook_Deactivate()
    Dim editcontrol As CommandBarControl
    Dim ctrl As CommandBarControl
    Dim rightclick As CommandBar
    
    'Get the Edit menu
    Set editcontrol = Application.CommandBars("Built-in Menus").Controls("Edit")
    
    
    For Each ctrl In editcontrol.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Restore default action
            ctrl.OnAction = ""
        End If
    Next
    
    'Get the right-click menu when you right-click on a cell
    Set rightclick = Application.CommandBars("Cell")
    
    For Each ctrl In rightclick.Controls
        'Find the Paste command
        If ctrl.Caption = "&Paste" Then
            'Restore default action
            ctrl.OnAction = ""
        End If
    Next
   
   'Restore default action to run on "CTRL - V" keystroke
   Application.OnKey "^{v}"
End Sub

Then this goes in a regular code module:

Code:
Option Explicit

Sub PasteIntercept() 'Called from "Onkey" method of application

    'Requires reference to Microsoft Forms 2.0 library
    
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then
        ActiveSheet.Paste
    Else
        MsgBox "Cannot paste data from an external source."
    End If
    
End Sub


This seems to work for me.

Good luck.
 
Upvote 0
Actually this code seems to accomplish both goals. Copying a button or image from within Excel does not put the application into the "xlCopy" or "xlCut" CutCopyMode, so using the code above these objects cannot be pasted into the workbook.
 
Upvote 0
Keith,

Thanks very much for your post and sorry for the delay in answering .

I have tested your code but it runs inconsistently.Also I have reduced some of the redundant code by putting everything in the PasteIntercept Procedure.

Following on your steps, I have come up with what seems to be a more consistent solution except for two things : ( Hopefully someone can figure out a solution for this )

1- The code doesn't prevent Drag & Drop.

2- It doesn't prevent copying an Item directly from the ClipBoard Pane (Office XP)

However, it does work for normal Pasting from ToolBars and Ctl + V.


Code to be placed in a Standard Module :


Code:
Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function GetClipboardOwner Lib "user32" () As Long

Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

Declare Function CloseClipboard Lib "user32" () As Long


Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, lpdwProcessId As Long) As Long

Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

Const CF_TEXT = 1

Dim lngprocID, lngXLhwnd, lngClip As Long



Sub PasteIntercept()
  
    If GetClipboardOwner <> 0 Then ' If Clipboard empty do nothing
        GetWindowThreadProcessId GetClipboardOwner, lngprocID
        ' if clipboard owner is another process don't paste data
        If lngprocID <> GetCurrentProcessId Then
            MsgBox "Can't Copy Data from outside XL !", vbCritical
            Exit Sub
        End If
        lngXLhwnd = FindWindow("XLMAIN", Application.Caption)
        lngClip = OpenClipboard(lngXLhwnd)
        'if data in clipboard is not text don't allow paste
        If GetClipboardData(CF_TEXT) = 0 Then
            MsgBox "Can't Copy Other than Text!", vbCritical
            GoTo cleanup
        End If
        ' otherwise paste data
        ActiveSheet.Paste
cleanup:
        CloseClipboard
    End If

End Sub

Sub CustomisePaste()

    With CommandBars
        .FindControl(ID:=22).OnAction = "PasteIntercept" ' Paste Button
        .FindControl(ID:=755).OnAction = "PasteIntercept" 'Paste special
    End With
    Application.OnKey "^{v}", "PasteIntercept" 'Ctl + V

End Sub

Sub RestoreDefault()

    With CommandBars
        .FindControl(ID:=22).Reset
        .FindControl(ID:=6002).Reset
        .FindControl(ID:=755).Reset
    End With
    Application.OnKey "^{v}"

End Sub


Code to be placed in the ThisWorkBook Module :

Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    RestoreDefault

End Sub

Private Sub Workbook_Open()

    CustomisePaste

End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)

    CustomisePaste

End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)

    RestoreDefault

End Sub

Regards.
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,239
Members
448,555
Latest member
RobertJones1986

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