custom menu items not responding after initial save

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

After saving a workbook created from a template with marcos (BOM
importation), the custom right click menu items I create error out. It seems
if you don't save the file using the default name then the menu error occurs.
 
Here's the code for the menu creation

Private WithEvents xlApp As Excel.Application

Private Sub Class_Initialize()
Set xlApp = Excel.Application
End Sub

Private Sub xlApp_SheetBeforeRightClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)

'Add or remove Hyperlink menu items based on whether or not Hyperlink(s)
are selected

Dim oCtrl As CommandBarControl
Dim oBtn As CommandBarControl
Dim bMenusExist As Boolean
Dim bHyperlinksExist As Boolean

For Each oCtrl In Application.CommandBars("Cell").Controls
If oCtrl.Caption = "Copy Hyperlinked Docs To..." Then
bMenusExist = True
Exit For
End If
Next

bHyperlinksExist = Target.Hyperlinks.Count > 0

If bHyperlinksExist And Not bMenusExist Then
Set oCtrl =
Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, _
Temporary:=True)
oCtrl.Caption = "Copy Hyperlinked Docs To..."
oCtrl.OnAction = "CopyHyperlinkedDocsTo"

Set oCtrl =
Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, _
Temporary:=True)
oCtrl.Caption = "Zip && Email Hyperlinked Docs..."
oCtrl.OnAction = "ZipAndEmailHyperlinkedDocs"
ElseIf Not bHyperlinksExist Then
For Each oCtrl In Application.CommandBars("Cell").Controls
If oCtrl.Caption = "Copy Hyperlinked Docs To..." Then
oCtrl.Delete
ElseIf oCtrl.Caption = "Zip && Email Hyperlinked Docs..." Then
oCtrl.Delete
End If
Next
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top