Controlling the ClipBoard

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,063
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.
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

scifibum

Well-known Member
Joined
Jul 22, 2004
Messages
503
(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.
 

scifibum

Well-known Member
Joined
Jul 22, 2004
Messages
503
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.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,063
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,433
Messages
5,572,080
Members
412,439
Latest member
BKPE
Top