Custom Ribbon Recovery Issues

Tlev

New Member
Joined
Sep 22, 2009
Messages
3
Hi everyone,

I've been working with custom Ribbons over the last couple of months and have just started trying to play around with the code that recovers the ribbon object should the vba backend bug out for any reason, thereby allowing the user to continue using the ribbon in the interim.

The code is along the lines of a few examples posted online where on opening the workbook the Ribbon object is converted to a Long variable and stored in a worksheet cell.

Unfortunately my version is not yet working and I think it may have something to do with the fact that unlike the more basic examples online on which it was based, my ribbon uses the getEnabled amongst other get* callups throughout.

Note: The custom Ribbon functioned well before adding the new code.

Here are the pertinent parts of my code:

XML:>>>>>>>>>>>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" on L o a d="rbx_o n L o a d_Axls">
<
ribbon startFromScratch="false">
<
tabs>
<tab id="customAXlsTab" label="TANSO" insertBeforeMso="TabHome" >
<group id="customGroup" label="Navigate">
<button id="customButton2" label="CDGF" onAction="Gotocfff_click" />
<
button id="customButton3" label="FFFFF" onAction="DGraphs_Click" />
<
button id="customButton4" label="Charts" onAction="GoToCharts_Click" />
<!--</font-->group>
<group id="customGroup1" label="Jump To J">
<comboBox id="Combobox1" getItemID="cmb_getItemID" getItemLabel="cmb_getItemLabel" getItemCount="cmb_itemCount" onChange="cmb_onChange" />
<!--</font-->group>
<
group id="customGroup2" label="RExports">
<button id="customButton5" label="SReport" tag="WFSF" onAction="SSForecast"
getEnabled="GetEnabledMacro"/>
<
button id="customButton6" label="Export Summary" tag="WFXS"
onAction="ExprtSummary" getEnabled="GetEnabledMacro"/>
<button id="customButton7" label="Export WIP" tag="WFXW"
onAction="ExprtJComp" getEnabled="GetEnabledMacro"/>
<separator id="sep3"/>
<
button id="customButton19" label="Print" onAction="Print_Click" />
<!--</font-->group>
<group id="customGroup5" label="I Actions">
<toggleButton id="customButton28" tag="WFIL" getLabel="GetILabel" onAction="ViewI"
getPressed="IReqStatus" getEnabled="GetEnabledMacro"/>
<!--</font-->group>
<
group id="customGroup6">
<toggleButton id="customButton20" getLabel="GetLabel" getImage="GetImage"
getPressed="GetPressed" onAction="Unlock_Click" />
<!--</font-->group>
<!--</font-->tab>
<!--</font-->tabs>
<!--</font-->ribbon>

<!--</font-->customUI>
_________________________________________________________________

VBA MODULE>>>>>>>>>>>>>>


Option Explicit

#If Win64 Then
Public Declare PtrSafe Sub
CopyMemory Lib " kernel32 " Alias "RtlMoveMemory" (destination As An y, source As Any, _
ByVal
length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, _
ByVal length As Long)

#End If

Public
grbxUI As IRibbonUI
Public
MyTag As String 'Used in Ribbon button enabling / disabling

'Used in lock button toggle icon only
Dim
UnlockedState As Boolean 'for which image & label to use
Dim
pressed As Boolean 'for whether toggle button is pressed or unpressed

'Used in Invoice req list toggle button only
Dim
ICheckedState As Boolean

Dim
Ipressed As Boolean


_____________________________________________________________________________________
Private Sub
rbx_o n L o a d_Axls(ribbon As IRibbonUI)'Code to initialise ribbon on opening.
Set
grbxUI = ribbon

'(Side Issue) This Line only works if there is only one custom tab even if the second custom tabs id is different.
'grbxUI.ActivateTab "customAXlsTab"

'TEST CODE FOR RIBBON RECOVERY

Dim
lngRibPtr As LongPtr
lngRibPtr = ObjPtr(ribbon)
Application.EnableEvents =
False
With
Sheets("Workflow")
.Unprotect Password:=""
.Range("K2").Value = lngRibPtr
.Protect Password:=""

End With
Application.EnableEvents = True

UnlockedState = False
ICheckedState = False
End Sub

______________________________________________________________

Private Sub
GetEnabledMacro(control As IRibbonControl, ByRef Enabled)
'Codes that tells all State changeable buttons on the Ribbon if they are enabled or not
If MyTag = "Enable" Then
Enabled = True
Else
If control.Tag Like MyTag Then
Enabled = True
Else
Enabled = False
End If
End If
End Sub
______________________________________________________________

Private Sub cmb_getItemID(control As IRibbonControl, index As Integer, ByRef ID)
ID = index
End Sub
______________________________________________________________

Private Sub cmb_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
Dim B As String
Dim numberofjs As Integer

numberofjs = Range("AREA").Rows.count

If Not Left(Range("AREA").Cells(numberofjs - index, 1), 1) = 1 Then
B = "0"
Else
B = ""
End If

returnedVal = B & Range("AREA").Cells(numberofjs - index, 2)

End Sub
___________________________________________________________________________________

Private Sub cmb_itemCount(control As IRibbonControl, ByRef count)
count = Range("AREA").count
End Sub
___________________________________________________________________________________

Private Sub GetImage(control As IRibbonControl, ByRef image)
Select Case control.ID
Case "customButton20"
Select Case UnlockedState
Case False: image = "Lock"
Case True: image = "EditForm"
End Select
End Select
End Sub
__________________________________________________________________________________

Private Sub GetLabel(ByVal control As IRibbonControl, ByRef label)
Select Case control.ID
Case "customButton20"
Select Case UnlockedState
Case False: label = "Locked"
Case True: label = "Unlocked"
End Select
End Select
End Sub
__________________________________________________________________________________

Private Sub GetPressed(control As IRibbonControl, ByRef pressed)
If ActiveSheet.ProtectContents = True Or ActiveSheet.Name = "CMM" Then
pressed = False
Else
pressed = True
End If
End Sub
__________________________________________________________________________________

Private Sub GetILabel(ByVal control As IRibbonControl, ByRef label)
Select Case control.ID
Case "customButton28"
Select Case ICheckedState
Case False: label = "Isolate Iso"
Case True: label = "Cancel Iso"
End Select
End Select
End Sub

_________________________________________________________________________________

Private Sub IReqStatus(control As IRibbonControl, ByRef Ipressed)

If ICheckedState = True Then
Ipressed = True
Else
Ipressed = False
End If

End Sub
_________________________________________________________________________________

Sub EnabledCMMButtons()
'Enable CMM controls
Call RefreshRibbon(Tag:="CF*")
End Sub
_________________________________________________________________________________

Sub EnabledAllButtons()
'Enable All controls
Call RefreshRibbon(Tag:="*")
End Sub

Sub RefreshRibbon(Tag As String)
'Refreshes the ribbon after different sheets are selected, so that specific buttons states will be changed
MyTag = Tag
If Not (grbxUI Is Nothing) Then
grbxUI.Invalidate
Else
' !!!!!!!!! THIS LINE BELOW IS WHERE IT BUGS OUT !!!!!!!!!!!!:
Set grbxUI = GetRibbon(CLng(Sheets("Workflow").Range("K2").Value))

grbxUI.Invalidate
End If
End Sub



The error that it returns upon opening the fill is:

Run-time error '6':

Overflow



Then upon clickin ok to the error message pop-up it highlights the Set grbxU...* line above followed by another pop up that says:

Can't execute code in break mode


I've spent a number of hours now looking online for suggestions and have tried and tested a number of failed solutions.

Does anyone have any ideas?

Cheers

TLev



 
Last edited:

Forum statistics

Threads
1,081,543
Messages
5,359,431
Members
400,526
Latest member
Brook1083

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top