Created an Excel progress bar class using CreateWindowEx API function, based on Randy Birch’s source code. I haven’t had time to implement 64 bit versions of the APIs, but let me know if you need it in a comment below and I will try to find some time.
It’s a common problem in VBA to lose reference to module level variables. For instance, untrapped errors will set object variables to nothing.
When dealing with ribbons in VBA this can be a serious problem : loss of a reference to the ribbon object means all further use of the object is impossible (Invalidate, etc.)
To work around this problem we have to store a reference to the ribbon object and retrieve it later if the reference is ever lost.
We can accomplish this using the CopyMemory, SetProp, GetProp , and RemoveProp APIs.
I store the ribbon in memory and save the memory pointer handle into Excel’s window property list.
The first event that fires when a workbook with a ribbon opens is the onload event of custom UI.
Private Sub RibbonOnLoad(Ribbon As IRibbonUI) #If VBA7 Then Dim lPtr As LongPtr #Else Dim lPtr As Long #End If If PointerExists Then Set RibbonObj = Nothing Set m_oRibbon = Ribbon lPtr = ObjPtr(Ribbon) If lPtr <> 0 Then If Not SetProp(Application.hWnd, m_sRibbonPtrName, lPtr) = 1 Then _ Err.Raise vbObjectError + 1, , "Error setting window property" End If End Sub
Here I check if there is already an instance of the ribbon saved to memory, and remove the old reference saved against the window property list.
Public Property Set RibbonObj(ByVal NewValue As Object) Dim lR As Long If NewValue Is Nothing Then lR = RemoveProp(Application.hWnd, m_sRibbonPtrName) End If Set m_oRibbon = NewValue End Property
The set property takes care of this. Setting the ribbon property to nothing removes the pointer from the property list.
Public Property Get RibbonObj() As Object Dim obj As Object #If VBA7 And Win64 Then Dim lPtr As LongPtr #Else Dim lPtr As Long #End If If Not m_oRibbon Is Nothing Then Set RibbonObj = m_oRibbon Else lPtr = GetProp(Application.hWnd, m_sRibbonPtrName) If lPtr = 0 Then Err.Raise vbObjectError + 1, , "Error retrieving window property" Else CopyMemory obj, lPtr, 4 Set m_oRibbon = obj Set RibbonObj = m_oRibbon CopyMemory obj, 0&, 4 End If End If End Property
Later when a reference to the ribbon object is needed, a still valid module reference will be returned. Otherwise the pointer reference is retrieved and used to instantiate the ribbon object from memory.