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
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
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.
 
Joined
May 23, 2013
Messages
34
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.
 
Joined
May 23, 2013
Messages
34

ADVERTISEMENT

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
 

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
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.
 
Joined
May 23, 2013
Messages
34
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,350
Messages
5,528,191
Members
409,807
Latest member
nicky736

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top