How to preserve or regain the Id of my custom ribbon UI?

[WernerGg]

I have a little Excel 2007 application with a standard ribbon UI. See the CustomUI.xml and the VBA-code below.

I have uploaded an Excel 2007 TestRibbonUI.xlsm to box.net from where you can get it with the link http://www.box.net/shared/8uznug7s3r

My new tab with name "My Tab" and id="tabCustom" has a group "grpToggle" with two buttons "btn1" and "btn2". Their enabled-states shall be controlled at runtime. Pressing any of them calles "DoButton" which just toggles both states.

The problem is that the UI is initialized only once during load. To change enabled-state or visibility, controls must be forced to reinitialize. For that we have to store the UIs Id during load by means of the o n L o a d -callback (sorry, the vBulletin-software replaces onL... with asterix. God knows why. Is this a dirty word?)

But this Id can only be stored in a static variable (Private guiRibbon As IRibbonUI), which gets lost after errors or during reset from the VBA-IDE.

The third button "Force Error" in our group just produces a zero division. After that the ribbon UI does no longer work and the workbook must be closed and reopen by the user.

Is there really no possibility to regain that guiRibbon value at runtime or store it somewhere else where it is save from being reset?

In the VBA help we can find an example which uses a method "guiRibbon.Refresh". I think this is exactly what we would need instead of the current ribbon UI design which is more than weak in that point. Unfortunatly that Refresh is not implemented.

Sorry I am not able to enter the xml-code and not the VBA code within code-tags. The vBulletin software always corrupts the things. Stupid!

 

[mikepfly2]

I know this is an older thread but hoping someone can help me out as I've been messing with this for days.

I'm using the loss of ribbon state noted earlier in this thread and from Ron's Ribbon site (Avoid losing the state of the global IRibbonUI ribbon object) to make my application more robust. However, I'd like to refresh the ribbon to a certain tag based on the activesheet when the workbook opens (there are 3 sheets: Codes, Companies and Contacts, each with a unique ribbon tag). Depending if the file is opened for the first time it defaults to the codes tab, otherwise, if it's saved as a user specific file it saves the activesheet at close and reopens to that sheet on open (after my enable macros tab is hidden).

Here is a basic test workbook I'm using. Every time I try to open the sheet it appcrashes. This is the case in Excel 2007 and 2010 (both 32 & 64 bit).

Any ideas would be most appreciated.

Workbook Open:

Option Explicit

Private Sub Workbook_Open()
    MyTag = "show"
    
    'App Crashes if this is called onopen:
    Call Workbook_SheetActivate(ActiveSheet)
    
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case ActiveSheet.CodeName
        Case "Sheet2"
            Call RefreshRibbon(Tag:="Test1")
        Case "Sheet3"
            Call RefreshRibbon(Tag:="Test2")
    End Select
End Sub

Ribbon Module:

Option Explicit

Public YourRibbon As IRibbonUI
Public MyTag As String

#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#Else
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#End If

Public Sub Ribbon******(ribbon As IRibbonUI)
   ' Store pointer to IRibbonUI
    Set YourRibbon = ribbon
    Sheet1.Range("A30").Value = ObjPtr(ribbon)
End Sub

#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
        Dim objRibbon As Object
        CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
        Set GetRibbon = objRibbon
        Set objRibbon = Nothing
End Function

Sub GetVisible(control As IRibbonControl, ByRef visible)
    If MyTag = "show" Then
        visible = True
    Else
        If control.Tag Like MyTag Then
            visible = True
        Else
            visible = False
        End If
    End If
End Sub

Sub RefreshRibbon(Tag As String)
    MyTag = Tag
    If YourRibbon Is Nothing Then
        Set YourRibbon = GetRibbon(Sheets(1).Range("A30").Value)
        YourRibbon.Invalidate
        MsgBox "The Ribbon handle was lost, Hopefully this is sorted now by the GetRibbon Function?. You can remove this msgbox, I only use it for testing"
    Else
        YourRibbon.Invalidate
    End If
End Sub

I tried multiple times to put the XML in here but it kept screwing up (tried code tags, html and php tags, no luck). Here is my test file on dropbox: https://www.dropbox.com/s/s9rulv0m4tz3zhi/LossofRibbonState-SpecificTab-MrExcelPost.xlsm
<customui ******="Ribbon******" xmlns="http://schemas.microsoft.com/office/2006/01/customui"><ribbon><tabs><tab id="MyCustomTab" label="My Tab" insertaftermso="TabHome" =""=""><group id="customGroup1" label="Group 1" tag="Test1" getvisible="GetVisible"><button id="customButton4" label="Caption 4" size="normal" onaction="Macro4" imagemso="TextAlignGallery">
<ribbon><tabs><tab id="MyCustomTab" label="My Tab" insertaftermso="TabHome" =""=""> </tab></tabs></ribbon></button></group></tab></tabs></ribbon></customui>

 

[RoryA]

I haven't had time to look at the file but does it help if you remove the code from the Open event, put it in a routine in a normal module and call that from the open event using Application.Ontime with say a 1 second delay?

 

[mikepfly2]

SOLVED:
Thanks for the quick response. I tried application.wait before submitting my original post (and it didn't work) but ontime seemed to do the trick. Thank you so much! Is it just giving time for the ribbon to initialize?

Here is my working code:

Workbook_Open:

Private Sub Workbook_Open()    
    MyTag = "show"
    Application.OnTime Now + TimeSerial(0, 0, 1), "SheetChange"
End Sub

In a Module:

Sub SheetChange()    
   Select Case ActiveSheet.CodeName
        Case "Sheet2"
            Call RefreshRibbon(Tag:="Test1")
        Case "Sheet3"
            Call RefreshRibbon(Tag:="Test2")
    End Select
End Sub

You're the man, Rory!

 

[RoryA]

Yes, it is. I generally try and avoid calling any startup code directly in the Open event especially when it relates to commandbars/ribbon.

 

[BartDenOuden]

Hi,

I also tried to use this solution. It crashed Excel each time after invalidating the ribbon three times. The crash was caused by "CopyMemory". Instead of copying memory it seems much more robust to reference a pointer to the original place in memory where the ribbon resides (I'm not a programmer so I hope I'm being clear). Instead of using "CopyMemory" I used the function "PtrObj" I found here: http://www.thoughtproject.com/Snippets/PtrObj/PtrObj.bas.txt

Here's how I used it:

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Target As Any, ByRef Source As Any, ByVal Length As Long)
' ===================================================================
' PtrObj
' ===================================================================


Public Function PtrObj(ByVal Pointer As Long) As Object


  Dim SoftRef As Object
  
  ' Exit immediately it the Pointer is Null.  The function
  ' will return the default value of Nothing.
  If Pointer = 0 Then
    Exit Function
  End If
  
  ' Get a soft reference to the object
 RtlMoveMemory SoftRef, Pointer, 4
  
  ' Get a legal reference to the object
   Set PtrObj = SoftRef
  
  ' Destroy the illegal reference
  RtlMoveMemory SoftRef, 0&, 4


FunctionExit:
  Exit Function
  
FunctionError:
  Set PtrObj = Nothing
  Resume FunctionExit


End Function





Public Sub InitMyRibbon(Ribbon As IRibbonUI)
    Dim lngRibPtr As Long
    
    lngRibPtr = ObjPtr(Ribbon)
    SheetParameters.Range("Name_PntrRibbon") = lngRibPtr
End Sub





Public Sub UpdateRibbon()
    Dim Ribbon As Object
    Dim lngRibPtr As Long
    
    lngRibPtr = SheeetParameters.Range("Name_PntrRibbon")
    Set Ribbon = PtrObj(lngRibPtr)
    Ribbon.Invalidate
    Set Ribbon = Nothing
End Sub

 

[RoryA]

Your PtrObj function actually uses exactly the same API call (RtlMoveMemory). The only difference I can see is in these additional lines:

' Destroy the illegal reference
RtlMoveMemory SoftRef, 0&, 4

which may explain the different behaviour. I will add them to my original code for safety - thank you!

 

[xlneedy]

Hi,

I also tried to use this solution. It crashed Excel each time after invalidating the ribbon three times. The crash was caused by "CopyMemory". Instead of copying memory it seems much more robust to reference a pointer to the original place in memory where the ribbon resides (I'm not a programmer so I hope I'm being clear). Instead of using "CopyMemory" I used the function "PtrObj" I found here: http://www.thoughtproject.com/Snippets/PtrObj/PtrObj.bas.txt

Here's how I used it:




Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Target As Any, ByRef Source As Any, ByVal Length As Long)
' ===================================================================
' PtrObj
' ===================================================================


Public Function PtrObj(ByVal Pointer As Long) As Object


Dim SoftRef As Object

' Exit immediately it the Pointer is Null. The function
' will return the default value of Nothing.
If Pointer = 0 Then
Exit Function
End If

' Get a soft reference to the object
RtlMoveMemory SoftRef, Pointer, 4

' Get a legal reference to the object
Set PtrObj = SoftRef

' Destroy the illegal reference
RtlMoveMemory SoftRef, 0&, 4


FunctionExit:
Exit Function

FunctionError:
Set PtrObj = Nothing
Resume FunctionExit


End Function





Public Sub InitMyRibbon(Ribbon As IRibbonUI)
Dim lngRibPtr As Long

lngRibPtr = ObjPtr(Ribbon)
SheetParameters.Range("Name_PntrRibbon") = lngRibPtr
End Sub





Public Sub UpdateRibbon()
Dim Ribbon As Object
Dim lngRibPtr As Long

lngRibPtr = SheeetParameters.Range("Name_PntrRibbon")
Set Ribbon = PtrObj(lngRibPtr)
Ribbon.Invalidate
Set Ribbon = Nothing
End Sub

Thank you VERY MUCH BartDenOuden!! I struggled for hours before seeing this post. You are a life saver.. This works perfectly for me.

 

[tacticaltrading]

A quick thank you as this is exactly what I needed.
I store the object ID in a workbook Name / RefersTo, with visibility = False.
Thanks

 

[andypugh]

I found a need to implement this in my own macro code.
I actually wrapped it all in a new non-volatile ribbon class.

I found that it was possible to cause a rather serious problem by storing a ribbon pointer from a previous instance in the workbook. My code now stores both the ribbon pointer and the application pointer, and only uses the stored ribbon pointer if the Application pointer matches the current one.
This made things rather more robust.

 

[tacticaltrading]

I found a need to implement this in my own macro code.
I actually wrapped it all in a new non-volatile ribbon class.

I found that it was possible to cause a rather serious problem by storing a ribbon pointer from a previous instance in the workbook. My code now stores both the ribbon pointer and the application pointer, and only uses the stored ribbon pointer if the Application pointer matches the current one.
This made things rather more robust.

I have stumbled upon exact issue you discuss. Which in my case happens if you do a SaveAs, which can cause a problem.
Are you willing to share this?


Thank you