More XRibbon questions

ClimoC

Well-known Member
Joined
Aug 21, 2009
Messages
584
I'm getting there... slowly.

I have no problem with the XML. That's all fine.

My checkBoxes are linked to 3 cells in a data-store sheet. Click the checkbox, and the value is set in the datasheet to true/false, reflecting the checkbox.

But they always start as False. One of the checkboxes I'd like to default to True

Current Ribbon VB code:

Code:
Public MyRibbon As IRibbonUI

Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (destination As Any, source As Any, _
    ByVal length As Long)

Public Sub ribb******ed(ribbon As IRibbonUI)
   ' Store pointer to IRibbonUI
   Dim lngRibPtr As Long
' Store the custom ribbon UI Id in a static variable.
' This is done once during load of UI. I.e. during workbook open.
    Set guiRibbon = ribbon
    lngRibPtr = ObjPtr(ribbon)
    ' Write pointer to worksheet for safe keeping
    Thisworkbook.Sheets("GridData").Range("E10").Value = lngRibPtr
    ShwKeyDates = True
End Sub

Function GetRibbon(lngRibPtr As Long) As Object
   Dim objRibbon As Object
   CopyMemory objRibbon, lngRibPtr, 4
   Set GetRibbon = objRibbon
   Set objRibbon = Nothing
End Function

Public Sub RXReFire(Thisribbon As IRibbonUI)
    Set MyRibbon = Thisribbon
End Sub

Public Sub RefreshRibbon()
If Not (MyRibbon Is Nothing) Then

    MyRibbon.Invalidate
    ribb******ed MyRibbon
Else
Set MyRibbon = GetRibbon(CLng(Thisworkbook.Sheets("GridData").Range("E10").Value))
    MyRibbon.Invalidate
    ribb******ed MyRibbon
End If
End Sub

Public Sub GetPressed(control As IRibbonControl, ByRef pressedState)
        Select Case control.ID
                Case "SeriesInSlotChk"
                    If Thisworkbook.Sheets("GridData").Range("D6").Value = "TRUE" Then
                            pressedState = True
                    End If
                Case "ShowKeyDates"
                    If Thisworkbook.Sheets("GridData").Range("D7").Value = "TRUE" Then
                            pressedState = True
                    End If
                Case "ShwKeyDates"
                    If Thisworkbook.Sheets("GridData").Range("E7").Value = "TRUE" Then
                            pressedState = True
                    End If
                End Select
                
End Sub

Public Sub ClickAction(control As IRibbonControl, pressed As Boolean)
        Select Case control.ID
                Case "SeriesInSlotChk"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E6").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E6").Value = "FALSE"
                    End If
                Case "ShwKeyDates"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E7").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E7").Value = "FALSE"
                    End If
                Case "EpNumInSlotChk"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E8").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E8").Value = "FALSE"
                    End If
        End Select
                
                    
End Sub

So I'd assume that either when the Ribbon is invalidated to update, or at least just once during my workbook_open script, I throw in Call somewhere.

Helpy?

Thanks
C
 
Perhaps try it without the Select Case statement and just quick-and-dirty try assigning them all to TRUE to see if it works? :S

Regards
Adam
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Still nothing.
Here's the full module. Anything look out of place?

Code:
Public MyRibbon As IRibbonUI

Public Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (destination As Any, source As Any, _
    ByVal length As Long)

Public Sub ribb******ed(ribbon As IRibbonUI)
   ' Store pointer to IRibbonUI
   Dim lngRibPtr As Long
' Store the custom ribbon UI Id in a static variable.
' This is done once during load of UI. I.e. during workbook open.
    Set guiRibbon = ribbon
    lngRibPtr = ObjPtr(ribbon)
    ' Write pointer to worksheet for safe keeping
    Thisworkbook.Sheets("GridData").Range("E10").Value = lngRibPtr
    ShwKeyDates = True
End Sub

Function GetRibbon(lngRibPtr As Long) As Object
   Dim objRibbon As Object
   CopyMemory objRibbon, lngRibPtr, 4
   Set GetRibbon = objRibbon
   Set objRibbon = Nothing
End Function

Public Sub RXReFire(Thisribbon As IRibbonUI)
    Set MyRibbon = Thisribbon
End Sub
'Callback for GTime getLabel
Sub GetLabelText1(control As IRibbonControl, ByRef returnedVal)
    returnedVal = Thisworkbook.Sheets("ForwardPlan").Range("F87").Text
End Sub

'Callback for GDate getLabel
Sub GetLabelText2(control As IRibbonControl, ByRef returnedVal)
    returnedVal = Thisworkbook.Sheets("ForwardPlan").Range("G87").Text
End Sub

'Callback for Prog getLabel
Sub GetLabelText3(control As IRibbonControl, ByRef returnedVal)
On Error Resume Next
    returnedVal = Left(ActiveCell.Value, InStr(1, ActiveCell.Value, "{{#", vbTextCompare) - 1)
    Err.Clear
    On Error GoTo 0
End Sub

Public Sub RefreshRibbon()
If Not (MyRibbon Is Nothing) Then

    MyRibbon.Invalidate
    ribb******ed MyRibbon
Else
Set MyRibbon = GetRibbon(CLng(Thisworkbook.Sheets("GridData").Range("E10").Value))
    MyRibbon.Invalidate
    ribb******ed MyRibbon
End If
End Sub
Public Sub RepeatSlot()
SecLvl = Thisworkbook.Sheets("GridData").Range("E2").Value

RepeatForm.Show

End Sub

Sub colourrrs()

For Each r In Range("AA2:AA" & Range("A65000").End(xlUp).Row)
        r.Value = 16777215
Next
End Sub
Public Sub RibbonPressed(control As IRibbonControl)
    SecLvl = Thisworkbook.Sheets("GridData").Range("E2").Value
    
    Select Case control.ID
    Case "PDFEXPORT"
            Run "ExportAsPDF"
    Case "LogIn"
            LogInForm.Show
    Case "AddUsr"
            If SecLvl > 1 Then
                    Run "ShowNewUserForm"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "RefreshDB"
          Run "ReloadDatabase"
    Case "ReconDB"
            If SecLvl > 1 Then
                Run "UpdateDBValues"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "Exportable"
            If SecLvl > 2 Then
                    Run "CSVO"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "EditEntry"
            If SecLvl > 1 Then
                Run "ShowEditForm"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "Reporter"
            If SecLvl > 0 Then
                Run "ShowReportingForm"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "AddProg"
            If SecLvl > 1 Then
                Run "ShowAddForm"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "ImpDB"
            If SecLvl > 0 Then
                Run "ShowChannelChange"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "Redraw"
            If SecLvl > 0 Then
                Run "CreateNewGrid"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "Touch"
            If SecLvl > 0 Then
                Run "TouchUps"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "InsProg"
            If SecLvl > 1 Then
                Run "ShowAssetList"
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "ColSlots"
            If SecLvl > 0 Then
                ColourHighlightForm.Show
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "Hypo"
            If SecLvl > 1 Then
                Hypoths.Show
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "CleanUp"
            If SecLvl > 1 Then
                CleanUpForm.Show
            Else
                Beep
                MsgBox "Access Denied", vbCritical
            End If
    Case "EPG"
                Run "EPGSYNOPSIS"

  End Select

    
End Sub

Public Function GetPressed(control As IRibbonControl, ByRef pressedState)
        Select Case control.ID
                Case "SeriesInSlotChk"
                    If Thisworkbook.Sheets("GridData").Range("E6").Value = True Then
                            'pressedState = True
                            GetPressed = True
                    End If
                Case "ShwKeyDates"
                    If Thisworkbook.Sheets("GridData").Range("E7").Value = True Then
                            'pressedState = True
                            GetPressed = True
                    End If
                Case "EpNumInSlotChk"
                    If Thisworkbook.Sheets("GridData").Range("E8").Value = True Then
                            'pressedState = True
                            GetPressed = True
                    End If
        End Select
                
End Function

Public Function ClickAction(control As IRibbonControl, pressed As Boolean)
        Select Case control.ID
                Case "SeriesInSlotChk"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E6").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E6").Value = "FALSE"
                    End If
                Case "ShwKeyDates"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E7").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E7").Value = "FALSE"
                    End If
                Case "EpNumInSlotChk"
                    If pressed = True Then
                            Thisworkbook.Sheets("GridData").Range("E8").Value = "TRUE"
                    ElseIf pressed = False Then
                            Thisworkbook.Sheets("GridData").Range("E8").Value = "FALSE"
                    End If
        End Select
                
                    
End Function

Sub crashmeforlossofstate()
Dim Death As Long
Death = 1 / 0

End Sub

NB: It doesn't seem to matter whether I use '= "TRUE"' or '= True', they both correctly read the String/Boolean
 
Upvote 0
Doesn't look wrong. Did you try commenting out the whole Select Case statement and just returning TRUE for everything to see if that works? What about the XML code?

Regards
Adam
 
Upvote 0
Double whoops...


*customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" ******="RXReFire"*
*ribbon*
*tabs*

*tab id="FwdPlan" label="Forward Planning"*
*group id="DataGrp" label="Data"*

*button id="RefreshDB" label="Reload Database" size="large"
onAction="RibbonPressed" imageMso="AdpViewSqlPane"
screentip="Recommits the Database to Memory, in case of any errors or unusual behaviour" /*
*button id="ReconDB" label="Update with Changes" size="large"
onAction="RibbonPressed" imageMso="ImportSharePointList"
screentip="Confirms your Grid Slot changes to the Local Database. Does not Write out to the Server." /*
*button id="Exportable" label="Publish" size="large"
onAction="RibbonPressed" imageMso="BibliographyManageSources"
screentip="Exports this Local channel Database to the main Server, overwriting the existing file" /*
*button id="EPG" label="EPG" size="large"
onAction="RibbonPressed" imageMso="BusyUI"
screentip="Create a custom EPG with channels,dates and times (opens in a new window)" /*
*button id="Reporter" label="Reporting" size="large"
onAction="RibbonPressed" imageMso="ClickToRunAboutUpdates"
screentip="Select from a range of Custom Reports on this and other Databases" /*
*button id="AddProg" label="Add Programme(s)" size="large"
onAction="RibbonPressed" imageMso="AdpDiagramAddTable"
screentip="Add Single or Series of Programmes to the Local Database" /*
*button id="ImpDB" label="Change Channel" size="normal"
onAction="RibbonPressed" imageMso="DownloadContents"
screentip="Import a different Database to the Local Instance" /*
*button id="Hypo" label="Save/Load Draft" size="normal"
onAction="RibbonPressed" imageMso="BibliographyAddNewPlaceholder"
screentip="Export this as a Hypothetical Schedule. Does not affect Published server versions of the database" /*
*button id="CleanUp" label="Clean Up Drafts" size="normal"
onAction="RibbonPressed" imageMso="AccessRecycleBin"
screentip="Manage your list of Hypothetical/Draft Versions of this Channel's Schedules" /*





*/group*
*group id="Prnt" label="Export"*
*button id="PDFEXPORT" label="PDF" size="large"
onAction="RibbonPressed" imageMso="PasteMergeConditionalFormatting"
screentip="Saves a PDF form of the Current Grid Range to your Desktop" /*
*/group*

*group id="GridGrp" label="Scheduling Grid"*

*button id="Redraw" label="Redefine Grid" size="large"
onAction="RibbonPressed" imageMso="ArrangeByDate"
screentip="Re-Draws the Programme Slots to the Grid based on information in the local Database" /*
*button id="Touch" label="Formatting Touch-Up" size="large"
onAction="RibbonPressed" imageMso="AutoFormat"
screentip="Reapplies saved colours, colour scheme, and restores borders/fonts" /*

*/group*

*group id="Progs" label="Programmes"*

*button id="ColSlots" label="Colour Slots" size="large"
onAction="RibbonPressed" imageMso="DataValidationCircleInvalid"
screentip="Colour slots that match certain criteria" /*
*/group*

*group id="Usrz" label="Users"*

*button id="LogIn" label="LogIn/Change User" size="large"
onAction="RibbonPressed" imageMso="ContactRoles"
screentip="Switch User" /*
*/group*

*group id="FPOptions" label="Options"*
*checkBox id="SeriesInSlotChk" label="Show Series Name in Slots"
ScreenTip = "When active, Titles inside programme slots will show the Series Name (Where available)"
enabled="true" getPressed="GetPressed"
onAction="ClickAction" /*
*checkBox id="ShwKeyDates" label="Show Competitor Highlights"
ScreenTip = "Highlights Competitor (inhouse and external) Key items in Comment boxes in the Grid Borders"
enabled="true" getPressed="GetPressed"
onAction="ClickAction" /*
*checkBox id="EpNumInSlotChk" label="Show Ep. # in First Slot"
ScreenTip = "When active, the First Slot in a linked series will be displayed with the Episode Number as well"
enabled="true" getPressed="GetPressed"
onAction="ClickAction" /*

*/group*
*group id="GDT" label="Current Info"*
*labelControl id="GTime" getLabel="GetLabelText1"/*
*labelControl id="GDate" getLabel="GetLabelText2"/*
*labelControl id="Prog" getLabel="GetLabelText3"/*
*/group*
*/tab*
*tab idMso="TabHome"*
*group idMso="GroupEditing" visible="false" /*
*group idMso="GroupClipboard" visible="false" /*

*/tab*



*/tabs*
*/ribbon*
*/customUI*
 
Upvote 0
You have
Rich (BB code):
Public MyRibbon As IRibbonUI

but then
Rich (BB code):
Set guiRibbon = ribbon
 
Upvote 0
Thanks Rory.

I've fixed that now, but I didn't notice any problems with it (GetLabelText Functions were still working with each invalidation)

Still doesn't get the property for the checkBoxes though.

In truth, whilst it would be good for it to get the Boolean value for checked/unchecked from the "GridData" worksheet, as long as my workbook_open event sets the cell value to True, then as long as I can load the ribbon with checkBox2 (ShwKeyDates) ticked, I'd be ok with that for a workaround

Using my XML, my RibbonX VBA, and a worksheet called "GridData" with cell E7 showing 'TRUE', does anyone get the same problem? (Asking a lot more of people now than just reading and commenting on my code...)

C
 
Upvote 0
Sorry I couldn't get it man. I will try again later when I get home as I'm on an old version of Excel here at work so I can't test anything :S

Regards
Adam
 
Upvote 0
Your original code was correct - it should be using pressedState as the return value.
Also, you have three instances of 'ScreenTip' rather than 'screentip' in your XML, which is invalid.
 
Upvote 0

Forum statistics

Threads
1,216,186
Messages
6,129,393
Members
449,507
Latest member
rjwalker1973

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top