Custom Menu not opening when called from another sheet

[Absolution]

I have a set of *workbooks* which I access from a *workbook laid out like a menu* with form buttons assigned to macros. The *workbook* I am calling from has the following macro:

Sub OpenArtefact()
'
' OpenArtefact Macro

    Workbooks.Open Filename:= _
        "C:\SerimRal\Game 23 Information\Artefact Rumours.xls"

End Sub

The *workbook* I am calling from this has the following code:

Public Const TbarName = "SR23 Profile Options"

Sub Auto_Open()

On Error GoTo Errorhandler

Dim c
Dim i As Integer
Dim customBar As CommandBar
Dim CBar1

Dim newButton As CommandBarButton

'************************************************************************************
' Check the existing toolbars - if the one you want exists, make it visible
'************************************************************************************

For Each c In CommandBars
    If c.Name = TbarName Then
        c.Visible = True
        Application.CommandBars(TbarName).Controls(1).Enabled = True
        Application.CommandBars(TbarName).Controls(4).Enabled = True
        For i = 2 To 3
            Application.CommandBars(TbarName).Controls(i).Enabled = True
        Next i
        c.Delete
        Exit Sub
    End If
Next

'*************************************************************************************
' If haven't exited add the toolbar
' Position determines where it's displayed (e.g. msoBarTop, ...left or floating)
'*************************************************************************************
Set CBar1 = CommandBars.Add(Name:=TbarName, Position:=msoBarFloating, Temporary:=False)


With Application
    
    
    '*********************************************************************************
    ' Add the number of controls that you want
    '*********************************************************************************
    For i = 1 To 7
        CBar1.Controls.Add
    Next i
    
    '*********************************************************************************
    ' Assign the properties for each control
    '
    '*********************************************************************************
    With CBar1
        .Controls(1).Style = msoButtonCaption
        .Controls(1).OnAction = "FindArtefact"
        .Controls(1).Caption = "Locate Artefact    "
        .Controls(1).TooltipText = "Locate Artefact"
        .Controls(1).Enabled = True
        
        

        .Controls(2).Style = msoButtonCaption
        .Controls(2).OnAction = "ManualArtInputter"
        .Controls(2).Caption = "Manual Input        "
        .Controls(2).TooltipText = "Clear Fields to enable Location from manual Source"
        .Controls(2).Enabled = True
        
        
        .Controls(3).Style = msoButtonCaption
        .Controls(3).OnAction = "AutoArtefactInput"
        .Controls(3).Caption = "Auto Input            "
        .Controls(3).TooltipText = "Allows Location from listed rumours"
        .Controls(3).Enabled = True
        
        .Controls(4).Style = msoButtonCaption
        .Controls(4).OnAction = "GotoFreeform"
        .Controls(4).Caption = "Enter Freeform Results"
        .Controls(4).TooltipText = "Allows Input of realm or know areas"
        .Controls(4).Enabled = True
        
        .Controls(5).Style = msoButtonCaption
        .Controls(5).OnAction = "GotoCastle"
        .Controls(5).Caption = "Go To Castle List     "
        .Controls(5).TooltipText = "Moves to castle listings"
        .Controls(5).Enabled = True
        
        .Controls(6).Style = msoButtonCaption
        .Controls(6).OnAction = "GotoArtifacts"
        .Controls(6).Caption = "Go to Artefact Rumours"
        .Controls(6).TooltipText = "Moves to Artefact Rumour Sheet"
        .Controls(6).Enabled = True
        
        .Controls(7).Style = msoButtonCaption
        .Controls(7).OnAction = "ExitProfile"
        .Controls(7).Caption = "Exit Sheet              "
        .Controls(7).TooltipText = "Exits the Sheet"
        .Controls(7).Enabled = True
        
        
        '*********************************************************************************
        ' The "pop up" menu is a control with controls added to its commandbar
        '*********************************************************************************
        Application.CommandBars(TbarName).Controls.Add Type:=msoControlPopup, Before:=4
        .Controls(4).TooltipText = "Update Option"
        .Controls(4).Caption = "Updates                   "
        
        With Application.CommandBars(TbarName).Controls(4).CommandBar
            For i = 1 To 5
                .Controls.Add
            Next
            .Controls(1).Style = msoButtonCaption
            .Controls(1).OnAction = "UpdateGodNames"
            .Controls(1).Caption = "Update God Names"
            .Controls(1).TooltipText = "Updates Sheet to add new god names"
       
            .Controls(2).Style = msoButtonCaption
            .Controls(2).OnAction = "SortRumours"
            .Controls(2).Caption = "Sort Rumours"
            .Controls(2).TooltipText = "Sorts the Artefacts Rumours"
            
            .Controls(3).Style = msoButtonCaption
            .Controls(3).OnAction = "SortCastles"
            .Controls(3).Caption = "Sort Castles"
            .Controls(3).TooltipText = "Sorts the Castles into Alphabetical Order"
            
            .Controls(4).Style = msoButtonCaption
            .Controls(4).OnAction = "xmap"
            .Controls(4).Caption = "X all Freeform"
            .Controls(4).TooltipText = "This option resets the freeform map"
            
            .Controls(5).Style = msoButtonCaption
            .Controls(5).OnAction = "CalcSheet"
            .Controls(5).Caption = "Calculate Sheet"
            .Controls(5).TooltipText = "This option calculates the sheet"
            
            
        End With
        
        
        '*********************************************************************************
        ' Add "Dividers"
        '*********************************************************************************
        .Controls(2).BeginGroup = True
        .Controls(4).BeginGroup = True
        .Controls(5).BeginGroup = True
        .Controls(8).BeginGroup = True
        
       For i = 1 To 8
            .Controls(i).Width = 100
        Next
               
               
    End With
    
    '*************************************************************************************
    ' Display the commandbar - by default it should display on a single line
    ' (even if floating) - you should be able to play with height and width to
    ' change this - here the width is 100 (buttons are 90) so this forces height
    ' its actually the last parameter that changes the display (so although the
    ' following gives height as the width is just over the button size, if you
    ' define height as 50 it will override the width command and the toolbar will
    ' go back to a single line)
    ' You'll get an error with some of these values if the toolbar is not "floating"
    '*************************************************************************************
    CBar1.Width = 100
    'CBar1.Height = 50
    CBar1.Top = 500
    CBar1.Left = 550
    CBar1.Visible = True
    Set CBar1 = Nothing

End With
Exit Sub
Errorhandler:
'*************************************************************************************
' Most likely error is setting width/ height of a non-floating toolbar.
'*************************************************************************************


Select Case Error
    Case "Method 'Width' of object 'CommandBar' failed"
        Message = "Toolbar is not floating - cannot vary width" & vbCrLf & vbCrLf & _
        "Change toolbar position?"
        response = MsgBox(Message, vbYesNo + vbQuestion, "Error")
        Select Case response
            Case vbYes
                CBar1.Position = msoBarFloating
                Resume Next
            Case vbNo
                Resume Next
        End Select
    Case "Method 'Height' of object 'CommandBar' failed"
        Message = "Toolbar is not floating - cannot vary height" & vbCrLf & vbCrLf & _
        "Change toolbar position?"
        response = MsgBox(Message, vbYesNo + vbQuestion, "Error")
        Select Case response
            Case vbYes
                CBar1.Position = msoBarFloating
                Resume Next
            Case vbNo
                Resume Next
        End Select
    Case Else
        MsgBox "Unexpected error: " & Error
        
End Select



End Sub
Sub Auto_Close()
For Each c In CommandBars
    If c.Name = TbarName Then
        c.Delete
    End If
Next

End Sub

With this code to hide the menu if another *workbook* is activated:

Private Sub Workbook_Activate()
'************************************************************************************
' This event makes the custom menu visible when workbook is active
'************************************************************************************
On Error Resume Next
With Application.CommandBars(TbarName)
    .Visible = True
End With

End Sub

Private Sub Workbook_Deactivate()
'************************************************************************************
' This event hides the custom menu when another sheet is active
'************************************************************************************
On Error Resume Next
With Application.CommandBars(TbarName)
    .Visible = False
End With

End Sub

For some reason, when I open the *workbook from Explorer* as a stand alone *workbook* it is fine and the menu appears as it is supposed to, but when I call it from the *menu Workbook* it does not open.

Anyone have any ideas ?

 

[Absolution]

Fair point, well made, Gibbs.

I have edited my original post to reflect your point. It is from different workbooks, not sheets in the book.

I understand the confusion caused by this, my apologies.

 

[XLGibbs]

If you only want the toolbar to appear in the one workbook, check out the following:

http://www.j-walk.com/ss/excel/tips/tip53.htm


What you are going to run into is that with your custom toolbar, the macros assigned to the buttons on the toolbar will need to be manually pointed to the "ThisWorkbook" version of your code EVERY TIME you run your program.

If you customize>right click buttons> assign macro, even with the file open you will see the filename.xls!Macroname syntax.

So when you create a new version and save your file with a different name, the macros will be looking for the "old" excel file....it is a pain in the ****.

It may also be causing some of your issues with the activate/deactivate, since it is activating a toolbar that (I am guessing a litte) Excel thinks is closed...

If you utilize the menumaker option that the link describes, you may solve a lot of problems. It worked for me on another project where I was having similar issues, with a very similar dilemma.

I simply run the menumaker code once the workbook is active. Instead of toggling the menu on / off. I tweaked it so that the menu would actually be created/deleted on activate/deactivate. It was a seemless result that offered no function detriment as any new macros or buttons could simply be typed into the menusheet...

 

[Absolution]

I tried this one before, but I didn't like the way it added to the toolbar. I much prefer the floating one in mine above.

I will have another look at it though as it was quite some time ago that I used it last.

I am wondering if maybe putting the actual creation of the menu in the workbook activate section would resolve this. Would make it all quite slow though and I want to be able to skip between sheets without too much chugging for the users.

 

[XLGibbs]

As I recall you can set the floating option as the default, as well as the position of the toolbar at creation. Of course, the slow down would be an issue. Just an option I have used in the past...

I will see if I can resolve it as asked as well..

 

[Absolution]

Floating

I don't know if I am missing something, but there appears to be no simple default to set it to floating that I can see.

I do like the way it works though, as I could then pop it in every sheet I have and not have to worry about having to rewrite the whole thing every time I have a new sheet to do. Will try play to rewrite the position.