DataObject.PutInClipboard causes Excel 2010 to hang

[Torchwood]

Hi,

My first post! Hopefully all inline with Forum rules ...

I'm a relatively experienced Excel / VBA user, but I've come across an interesting problem.

I develop/own a large set of workbooks that contain code, and recently users have been complaining that Excel has been hanging, with no way of exiting except for using Task Manager. They are loosing work, and obviously are not too happy with me.

The core of the problem is this: I use the Workbook_SheetActivate() event; the code for this contains the standard code that you can Google for saving and restoring the clipboard contents, to allow users to copy/paste between worksheets:

    Set oDataObj = New DataObject
    oDataObj.GetFromClipboard

    ' Main body of sub here

    On Error Resume Next
    oDataObj.PutInClipboard
    Set oDataObj = Nothing

I should add that I've used this code before without any problems at all. However, I can get my worksheets to hang every time if I do the following:

+ Assume workbook contains a couple of standard worksheet (Sheet1, Sheet2, ...)
+ From Sheet1, type data into a cell, and then CTRL-C to copy the data
+ Click on Sheet 2
+ CTRL-V to paste (note - works fine!)
+ Click on Sheet 1
+ Delete Sheet 1

At this point, as Sheet 1 is deleted, Excel activates Sheet 2, and the SheetActivate() event fires as normal. The code runs OK until .PutInClipboard is called, and then Excel hangs! Actually, it is slighly weirder than that - the code will actually run to the end of the event function (I know, 'cos I put some logging code after those lines), and then it hangs. However, if you step through the code in the VBA editor, this is where the problem is occurring. If I comment out that line then everything is OK.

Some info that is probably relevant; I made a clean / new workbook and put the above minimal code into it, and I got an error message that .PutInClipboard is not implemented!??

What's going on?

I'm using Excel 2010 (Professional Plus 2010, 32-bit, running on Windows 7).

Regards,

Torchwood

 

[Torchwood]

Well, a bit of progress; I've narrowed it down a bit further ...

Ignore this paragraph from my first post:

> Some info that is probably relevant; I made a clean / new workbook and put the above minimal code into it, and I got an error message that .PutInClipboard is not implemented!??

I can now create the error in a clean workbook, like this:

Make a new workbook with 3 sheets. Select all cells in each sheet and mark as 'unlocked'. In the VBA editor add a reference to Microsoft Forms 2.0 Object Library.

Then, put the below code into ThisWorkbook module:

Option Explicit

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Dim oDataObj As DataObject

    Set oDataObj = New DataObject
    oDataObj.GetFromClipboard

    With sh
        .Protect DrawingObjects:=True, _
                 Contents:=True, _
                 Scenarios:=True, _
                 AllowFiltering:=True, _
                 AllowInsertingRows:=True, _
                 AllowDeletingRows:=True, _
                 UserInterfaceOnly:=True
        .EnableOutlining = True
    End With

    On Error Resume Next
    oDataObj.PutInClipboard
    Set oDataObj = Nothing
End Sub

Save ... then type some text into a cell on Sheet1, CTRL-C the cell to copy, select Sheet2, CTRL-V to paste, select Sheet1, delete Sheet1.

At this point, my Excel hangs.

 

[RoryA]

Try testing to see if the app is in cut/copy mode first:

Private Sub Workbook_SheetActivate(ByVal sh As Object)   Dim oDataObj               As DataObject
   Dim bPaste                 As Boolean
   If Application.CutCopyMode <> False Then
      Set oDataObj = New DataObject
      oDataObj.GetFromClipboard
      bPaste = True
   End If
   With sh
      .Protect DrawingObjects:=True, _
               Contents:=True, _
               Scenarios:=True, _
               AllowFiltering:=True, _
               AllowInsertingRows:=True, _
               AllowDeletingRows:=True, _
               UserInterfaceOnly:=True
      .EnableOutlining = True
   End With


   On Error Resume Next
   If bPaste Then oDataObj.PutInClipboard
   Set oDataObj = Nothing
End Sub

 

[Torchwood]

Genius! How obvious was that!

Works fine.