Code Only Works on Certain Sheets Within a Workbook
 

I have the following code saved in a file on a network to add an item to the
cell shortcut list once right-clicked.

ThisWorkbook code

Private Sub Workbook_Activate()
AddItemToShortcut
End Sub

Private Sub Workbook_Deactivate()
ResetCellShortcut
End Sub

Sub AddItemToShortcut()

Dim NewItem As CommandBarControl
Set NewItem = CommandBars("Cell").Controls.Add(Type:=1, Befo=1,
Temporary:=True)
NewItem.Caption = "Add New Date"
NewItem.OnAction = "NewDate"
NewItem.BeginGroup = True

End Sub

Sub ResetCellShortcut()

CommandBars("Cell").Reset

End Sub

I believe the "Add New Date" feature should be available on any sheet within
the workbook once a cell is right-clicked. However, this function is only
available on certain sheets within the workbook.

This file is on a network, and multiple users are opening and closing the
file. Could this have lead to the issue? I also have previously saved a
test file on my desktop with the exact same code in it which works fine.
This led me to believe having multiple users open it could have created the
problem.

Thanks

Code Only Works on Certain Sheets Within a Workbook
 

I don't think it's the multiple users who are causing the problem.

I'm betting that you're in page break view on the troublesome sheets and in
normal view on the sheets where it works perfectly.

And as user, I wouldn't want you resetting my Cell menu--I may have other stuff
that you'd destroy!

The index for the cell popup in page break view is 3 more than the index in
normal view (but the numbers vary between versions of excel).

I'd use something like this:

Option Explicit
Const myCaption As String = "Add New Date"
Sub AddItemToShortcut()

Dim NewItem As CommandBarControl
Dim myIndex As Long
Dim iCtr As Long

myIndex = Application.CommandBars("Cell").Index

For iCtr = 0 To 3 Step 3
Set NewItem = Application.CommandBars(myIndex + iCtr).Controls.Add _
(Type:=1, Befo=1, Temporary:=True)
NewItem.Caption = myCaption
NewItem.OnAction = "'" & ThisWorkbook.Name & "'!NewDate"
NewItem.BeginGroup = True
Next iCtr
End Sub
Sub ResetCellShortcut()
Dim myIndex As Long
Dim iCtr As Long

myIndex = Application.CommandBars("Cell").Index

On Error Resume Next 'in case it's not there
For iCtr = 0 To 3 Step 3
Application.CommandBars(myIndex + iCtr).Controls(myCaption).Delete
Next iCtr
On Error GoTo 0

End Sub
Sub NewDate()
MsgBox "NewDate"
End Sub


asmithbcat wrote:

I have the following code saved in a file on a network to add an item to the
cell shortcut list once right-clicked.

ThisWorkbook code

Private Sub Workbook_Activate()
AddItemToShortcut
End Sub

Private Sub Workbook_Deactivate()
ResetCellShortcut
End Sub

Sub AddItemToShortcut()

Dim NewItem As CommandBarControl
Set NewItem = CommandBars("Cell").Controls.Add(Type:=1, Befo=1,
Temporary:=True)
NewItem.Caption = "Add New Date"
NewItem.OnAction = "NewDate"
NewItem.BeginGroup = True

End Sub

Sub ResetCellShortcut()

CommandBars("Cell").Reset

End Sub

I believe the "Add New Date" feature should be available on any sheet within
the workbook once a cell is right-clicked. However, this function is only
available on certain sheets within the workbook.

This file is on a network, and multiple users are opening and closing the
file. Could this have lead to the issue? I also have previously saved a
test file on my desktop with the exact same code in it which works fine.
This led me to believe having multiple users open it could have created the
problem.

Thanks

--

Dave Peterson

Code Only Works on Certain Sheets Within a Workbook
 

Dave,

You were right on. The sheets that I was having trouble on were in Page
Break view.

As for resetting the cell shortcut menu, no one had changed their menu, but
I've modified the code accordingly just in case.

Thanks for the help!

"Dave Peterson" wrote:

I don't think it's the multiple users who are causing the problem.

I'm betting that you're in page break view on the troublesome sheets and in
normal view on the sheets where it works perfectly.

And as user, I wouldn't want you resetting my Cell menu--I may have other stuff
that you'd destroy!

The index for the cell popup in page break view is 3 more than the index in
normal view (but the numbers vary between versions of excel).

I'd use something like this:

Option Explicit
Const myCaption As String = "Add New Date"
Sub AddItemToShortcut()

Dim NewItem As CommandBarControl
Dim myIndex As Long
Dim iCtr As Long

myIndex = Application.CommandBars("Cell").Index

For iCtr = 0 To 3 Step 3
Set NewItem = Application.CommandBars(myIndex + iCtr).Controls.Add _
(Type:=1, Befo=1, Temporary:=True)
NewItem.Caption = myCaption
NewItem.OnAction = "'" & ThisWorkbook.Name & "'!NewDate"
NewItem.BeginGroup = True
Next iCtr
End Sub
Sub ResetCellShortcut()
Dim myIndex As Long
Dim iCtr As Long

myIndex = Application.CommandBars("Cell").Index

On Error Resume Next 'in case it's not there
For iCtr = 0 To 3 Step 3
Application.CommandBars(myIndex + iCtr).Controls(myCaption).Delete
Next iCtr
On Error GoTo 0

End Sub
Sub NewDate()
MsgBox "NewDate"
End Sub


asmithbcat wrote:

I have the following code saved in a file on a network to add an item to the
cell shortcut list once right-clicked.

ThisWorkbook code

Private Sub Workbook_Activate()
AddItemToShortcut
End Sub

Private Sub Workbook_Deactivate()
ResetCellShortcut
End Sub

Sub AddItemToShortcut()

Dim NewItem As CommandBarControl
Set NewItem = CommandBars("Cell").Controls.Add(Type:=1, Befo=1,
Temporary:=True)
NewItem.Caption = "Add New Date"
NewItem.OnAction = "NewDate"
NewItem.BeginGroup = True

End Sub

Sub ResetCellShortcut()

CommandBars("Cell").Reset

End Sub

I believe the "Add New Date" feature should be available on any sheet within
the workbook once a cell is right-clicked. However, this function is only
available on certain sheets within the workbook.

This file is on a network, and multiple users are opening and closing the
file. Could this have lead to the issue? I also have previously saved a
test file on my desktop with the exact same code in it which works fine.
This led me to believe having multiple users open it could have created the
problem.

Thanks

--

Dave Peterson
.