Trapping Cut/Copy/Paste Creates Add-In Tab with Commands

Joined
May 23, 2013
Messages
34
I have some code to trap the Cut/Copy/Paste/Paste Special commands. When I enable trapping, why does it add an "Add-In" tab with the commands on the Ribbon Bar? It's not too big a deal, but it's a little irritating.

Code:
Public Function initiliazeCommandTrapping(Optional ByVal setToEnabled As Boolean = True)
    Const fnName = "initiliazeCommandTrapping"
    
    Dim oCtrl As Office.CommandBarControl
    If Not debugMode Then On Error GoTo err_Catch
    
    'if not currently cutting/copying...
    If Application.CutCopyMode = 0 Then Application.CellDragAndDrop = Not setToEnabled
    If setToEnabled Then
        Application.OnKey "^x", "'trapCutCommand ""OnKey""'"
        Application.OnKey "^c", "'trapCopyCommand ""OnKey""'"
        Application.OnKey "^v", "'trapPasteCommand ""OnKey""'"
        'Cut
        For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.OnAction = "'trapCutCommand """ & oCtrl.Caption & """'"
        Next oCtrl
        
        'Copy
        For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.OnAction = "'trapCopyCommand """ & oCtrl.Caption & """'"
        Next oCtrl
    
        'Paste
        For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
            oCtrl.OnAction = "'trapPasteCommand """ & oCtrl.Caption & """'"
        Next oCtrl
        'Paste Special
        For Each oCtrl In Application.CommandBars.FindControls(ID:=755)
            oCtrl.OnAction = "'trapPasteSpecialCommand """ & oCtrl.Caption & """'"
        Next oCtrl
    
    Else
        'RELEASE COMMAND TRAPPING
        Application.OnKey "^v"
        Application.OnKey "^x"
        Application.OnKey "^c"
        'Cut
        For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.OnAction = ""
        Next oCtrl
        
        'Copy
        For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.OnAction = ""
        Next oCtrl
        
        'Paste
        For Each oCtrl In Application.CommandBars.FindControls(ID:=22)
            oCtrl.OnAction = ""
        Next oCtrl
        'Paste Special
        For Each oCtrl In Application.CommandBars.FindControls(ID:=755)
            oCtrl.OnAction = ""
        Next oCtrl
    
    End If
    'Only run the resetTheRibbonBar() Function if using Excel 2007+ (12+); not tested on 2010 or 2013
    'Could be set to a range, if necessary, such as "12-13"
    execFn "resetTheRibbonBar", 12         'for ribbon bar commands (set separately)
    'also requires the Module mod2007
    
'    If Application.Version >= 12 Then resetTheRibbonBar 'for ribbon bar commands (set separately)
    initiliazeCommandTrapping = "Success probable " & IIf(setToEnabled, "enabling", "disabling") & "."
finish_Function: If Not debugMode Then On Error Resume Next
    If Not oCtrl Is Nothing Then Set oCtrl = Nothing
    Exit Function
err_Catch:
    If Err.Number = escErrorNumber Then
        escapeErrorHandler fnName
        Resume Next
    End If
    
    initiliazeCommandTrapping = errorMessage(fnName, Err.Description, Err.Number)
    Resume finish_Function
    Exit Function
End Function
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I'm not seeing anything in the code you've provided that should do that.

The code calls several procedures that you haven't posted and I suspect that's where the Add-In menu is being added.

Based on the names alone, perhaps "resetTheRibbonBar" does that step.
 
Upvote 0
The only thing resetTheRibbonBar() does is to invalidate the ribbon, so that it gets recreated.

If I comment out the lines setting oCtrl.OnAction, no "Add-In" menu is added.
 
Upvote 0
What is your code for the 4 OnAction macros?

Which version of Excel are you using?

It's Excel 2007. Here is what they look like. I cut out a bunch of commented out code, so hopefully this is a good representation.


Code:
Public Function trapCopyCommand(Optional ByVal calledHow As String = "")
    Const fnName = "trapCopyCommand"
    
    Dim runningSuccess As String, theSheet As String
    Dim returnErrorMsg As String
    
    If Not debugMode Then On Error GoTo err_Catch
    returnErrorMsg = errorMsgNotSet
    
    theSheet = ThisWorkbook.ActiveSheet.name
    If getVar("DragAndDrop_Active", , "") <> "" Or getVar("RangePick_Active", , "") <> "" Then
        runningSuccess = errorMsgStart & "Cannot use Copy during Drag and Drop or Range Picking."
        GoTo finish_Function
    End If
    
    'If active sheet is schedule worksheet...
    If sheetType(theSheet) = "Schedule" Then
            runningSuccess = rangeCutOrCopyNumbers(Selection.Address, theSheet, xlCopy)
            If Left(runningSuccess, Len(errorMsgStart)) = errorMsgStart Then
                returnErrorMsg = errorMessage(fnName, runningSuccess)
                GoTo finish_Function
            End If
    Else
        returnErrorMsg = errorMsgStart & "Copy trapped, but not a Schedule spreadsheet."
    End If
    
finish_Function: If Not debugMode Then On Error Resume Next
    If returnErrorMsg <> errorMsgNotSet Then
        If getPrefs("OnError_MessageUser", , True) Then
            MsgBox "There was an error on Copy." & vbNewLine & vbNewLine & runningSuccess, vbExclamation + vbOKOnly, "CUT/COPY/PASTE ERROR"
        End If
    End If
    Exit Function
err_Catch:
    If Err.Number = escErrorNumber Then
        escapeErrorHandler fnName
        Resume Next
    End If
    
    returnErrorMsg = errorMessage(fnName, Err.Description, Err.Number)
    Resume finish_Function
End Function
 
Public Function rangeCutOrCopyNumbers(ByVal theRange As String, ByVal theSheet As String, Optional ByVal cutOrCopy As Integer = xlCopy, Optional ByVal rangeCopyQueueName As String = originalCopyQueueName)
    Const fnName = "rangeCutOrCopyNumbers"
    
    Dim theCell As Range, i As Integer ', cellValues() As Variant, iRow As Integer, iColumn As Integer
    Dim runningSuccess As String
    
    If Not debugMode Then On Error GoTo err_Catch
    
    'The SheetChange event is triggered for each cell changed.  Let's not recalculate the sheet each time.
    setVar "DisableEvent_All", True
    ThisWorkbook.Sheets(theSheet).EnableCalculation = False
    i = 0
    setVar "RangeNumbers_" & rangeCopyQueueName, 0
    setVar "RangeNumbers_" & rangeCopyQueueName & "_RangeFrom", theRange
    setVar "RangeNumbers_" & rangeCopyQueueName & "_SheetFrom", theSheet
    setVar "RangeNumbers_" & rangeCopyQueueName & "_CutOrCopy", cutOrCopy
    For Each theCell In ThisWorkbook.Sheets(theSheet).Range(theRange)
        i = i + 1
        setVar "RangeNumbers_" & rangeCopyQueueName, i
        setVar "RangeNumbers_" & rangeCopyQueueName & "_" & i, theCell.Value
        
        'don't cut from "Locked" cells
        If cutOrCopy = xlCut Then
            If Not theCell.Locked Then theCell.Value = ""
        End If
    Next theCell
    rangeCutOrCopyNumbers = "Success probable."
finish_Function: If Not debugMode Then On Error Resume Next
    ThisWorkbook.Sheets(theSheet).EnableCalculation = True
    setVar "DisableEvent_All", False
    
    If Not theCell Is Nothing Then Set theCell = Nothing
    
    Exit Function
err_Catch:
    If Err.Number = escErrorNumber Then
        escapeErrorHandler fnName
        Resume Next
    End If
    
    rangeCutOrCopyNumbers = errorMessage(fnName, Err.Description, Err.Number)
    Resume finish_Function
End Function
 
Upvote 0
Unfortunately the code you've posted so far is still missing code needed to run 10 or more other called functions. I've tried to comment out statements making those references to try to replicate your results but that just wasn't feasible to do and still execute the code.

If possible, please provide an example workbook that demonstrates the problem with any sensitive data removed.
You could post that to a sharing site like box.com or send me a PM and we'll exchange email addresses.
 
Upvote 0
Thank you for your efforts, Jerry. Sorry for the lack of response. It's a minor thing, I suppose, though it makes no sense to me. Perhaps I'll get back to it later.
 
Upvote 0

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

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