When I run the following code it sometimes crashes on the first line
after the for loop start. The code adds/removes some menu items from
the 3 cell right click menus(There are 3 right click cell menus, one
for when a cell or area of cells are selected, one for entier row(s)
selected, and one for entire column(s) selected). I can get it to run
the line of code by debugging, then making the particular menu show
once, and then resuming the code. I can't get the error to repeat
consistently. Any ideas are appreciated. Thanks.
Code:
Sub Setup_Right_Click_Items()
Dim InsertIndex As Integer
Dim NewItem As CommandBarButton
Dim myIndex As CommandBarControl
Dim MenuArray
ReDim MenuArray(1 To 2, 1 To 3)
MenuArray(1, 1) = "Cell"
MenuArray(2, 1) = "Insert..."
MenuArray(1, 2) = "Row"
MenuArray(2, 2) = "Insert"
MenuArray(1, 3) = "Column"
MenuArray(2, 3) = "Insert"
For i = 1 To 3
Set myIndex = CommandBars(MenuArray(1,
i)).Controls(MenuArray(2, i)) '<--crashes here
On Error Resume Next
CommandBars(MenuArray(1, i)).Controls("Toggle
Merge").Delete
CommandBars(MenuArray(1, i)).Controls("Toggle
Wrap").Delete
CommandBars(MenuArray(1, i)).Controls("Paste As
Values").Delete
' default items i remove
CommandBars(MenuArray(1, i)).Controls("Pick From Drop-down
List...").Delete
CommandBars(MenuArray(1, i)).Controls("Add Watch").Delete
CommandBars(MenuArray(1, i)).Controls("Create
List...").Delete
CommandBars(MenuArray(1,
i)).Controls("Hyperlink...").Delete
CommandBars(MenuArray(1, i)).Controls("Look Up...").Delete
On Error GoTo 0
' move format cells to top
On Error Resume Next
CommandBars(MenuArray(1, i)).Controls("Format
Cells...").Delete
On Error GoTo 0
Set NewItem = Application.CommandBars(MenuArray(1,
i)).Controls.Add(ID:=855, befo=1)
With NewItem
.Caption = "Format Cells..."
End With
Set NewItem = Application.CommandBars(MenuArray(1,
i)).Controls("Cut")
With NewItem
.BeginGroup = True
End With
' Set up my addins
InsertIndex = myIndex.Index
Set NewItem = Application.CommandBars(MenuArray(1,
i)).Controls.Add(ID:=370, befo=InsertIndex)
With NewItem
.Caption = "Paste as Values"
.FaceId = 0
End With
InsertIndex = myIndex.Index
Set NewItem = Application.CommandBars(MenuArray(1,
i)).Controls.Add(befo=InsertIndex)
With NewItem
.Caption = "Toggle Wrap"
.OnAction = "Toggle_Wrap"
.BeginGroup = True
End With
InsertIndex = myIndex.Index
Set NewItem = Application.CommandBars(MenuArray(1,
i)).Controls.Add(befo=InsertIndex)
With NewItem
.Caption = "Toggle Merge"
.OnAction = "Toggle_Merge"
End With
Next i
End Sub