Ribbon on the fly (XML) 2

[hermanlaksko]

I am trying to run the belov code and the Ribbon is created but will not load or show if selected on a given form

Sub LetItRip()
Dim RibbonXml As String, A, B, RibName, Rib As Office.IRibbonUI
RibName = "MenuMainRib"
A = Array("&Adgang", "&Skift bruger", "Skift database", "Afslut program", _
"&Firma F3", "&Brugere", "&Grupper", "&Aktiviteter &", "& Niveauer", _
"&Centre", "&Vagtkategorier", "&Plantyper", "Outlook", "Skoleoversigt F4", "&Planoversigt F5", "&Vagtoversigt F6", "&Aktivitetsoversigt F7", _
"National planlægning", "&Luk alle vinduer F12", "F-Taster", "&Versions info", "&Om Studievalg Danmark") 'Button names
B = Array("=OpenAny('UserAdmin')", "=OpenAny('Login',False,False)", "=OpenAny('SkiftDatabase',True,false,True)", "=AslutPrg()", _
"=F3()", "=OpenAny('UserOverview')", "=OpenAny('Grupper')", "=OpenAny('ArrangementListe')", "=OpenAny('Centre')", "=OpenAny('VagtKategori')", "=OpenAny('PTyper')", _
"", "=F4()", "=F5()", "=F6()", "=F7()", "=CloseAllForms("")", "", "=OpenAny('Z_VerHist')", "=OpenAny('About')")

RibbonXml = "<?xml version='1.0' encoding='UTF-8'?>"
RibbonXml = RibbonXml + "<mso:customUI xmlns:mso='

http://schemas.microsoft.com/office/2009/07/customUI'

OnLoad='OnLoad' >"
'RibbonXml = "<mso:customUI xmlns:x1='

http://schemas.microsoft.com/office/2009/07/customui/macro'

xmlns:mso='

http://schemas.microsoft.com/office/2009/07/customui'

onLoad='InitNewRib'>"
'RibbonXml = "<customUI xmlns='

http://schemas.microsoft.com/office/2009/07/customui'

>"
'RibbonXml = RibbonXml + "<ribbon startFromScratch='true'>"
'Application.LoadCustomUI RibName, RibbonXml
RibbonXml = RibbonXml + "<mso:ribbon><mso:tabs><mso:tab id='Tools' label='" & RibName & "' insertBeforeQ='mso:TabFormat' >"
'Knapper i grp 1 - Filer
RibbonXml = RibbonXml + "<mso:group id='Filer' label='Brugere / database' autoScale='true' >"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup1' label='" & A(0) & "' screentip='Slet personer ikke brugt' supertip='1' onAction='" & B(0) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup2' label='" & A(1) & "' screentip='Gem Publish og Luk' onAction='" & B(1) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup3' label='" & A(2) & "' screentip='Reset' onAction='" & B(2) & "'/>"
RibbonXml = RibbonXml + "</mso:group>"

'Knapper i grp 2 - Opsætning
RibbonXml = RibbonXml + "<mso:group id='Opset' label='Indstillinger'>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup4' label='" & A(3) & "' screentip='Reset' onAction='" & B(3) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup5' label='" & A(4) & "' screentip='Reset' onAction='" & B(4) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup6' label='" & A(5) & "' screentip='Reset' onAction='" & B(5) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup7' label='" & A(6) & "' screentip='Reset' onAction='" & B(6) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup8' label='" & A(7) & "' screentip='Reset' onAction='" & B(7) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup9' label='" & A(8) & "' screentip='Reset' onAction='" & B(8) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup10' label='" & A(9) & "' screentip='Reset' onAction='" & B(9) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup11' label='" & A(10) & "' screentip='Reset' onAction='" & B(10) & "'/>"

RibbonXml = RibbonXml + "<mso:group id='Oversigter' label='Datalister' autoScale='true'>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup12' label='" & A(11) & "' screentip='Institutionsoversigt' onAction='" & A(11) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup13' label='" & A(12) & "' screentip='Udskriv tilsyn til PDF' onAction='" & A(12) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup14' label='" & A(13) & "' screentip='Vis udskrift for ressource' onAction='" & A(13) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup15' imageMso='MicrosoftVisualFoxPro' screentip='Fox' onAction=''" & A(14) & "''/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup16' imageMso='SlideNew' screentip='2' onAction='" & A(15) & "'/>"
RibbonXml = RibbonXml + "</mso:group>"

'Knapper i grp 2
RibbonXml = RibbonXml + "<mso:group id='Hjælp' label='ABC' autoScale='true'>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup17' label='" & A(16) & "' screentip='Udskriv planer for tilsyn' onAction='" & A(16) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup18' label='" & A(17) & "' screentip='Udskriv tilsyn til PDF' onAction='" & A(17) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup19' label='" & A(18) & "' screentip='Vis udskrift for ressource' onAction='" & A(18) & "'/>"
RibbonXml = RibbonXml + " <mso:button id='ButtonGroup20' imageMso='MicrosoftVisualFoxPro' screentip='Fox' onAction='" & A(19) & "'/>"
RibbonXml = RibbonXml + "</mso:group>"
RibbonXml = RibbonXml + "</mso:tab></mso:tabs></mso:ribbon></mso:customUI>"
Application.LoadCustomUI RibName, RibbonXml
Rib.ActivateTab RibName
ExitHere:
Exit Sub
Fail:
MsgBox Err.Description, , SD
Resume ExitHere
End Sub

I know that would be an easyer task to use a table witch I will do later but for now I use arrays, the thing works and it does create the ribbon but the ribbon will not show and the Sub gives an error on the last line (Rib.ActivateTab RibName) as the Rib is never set, but how to set the Rib variable I am unsure.

So 2 questions.:
1. Why will it not show?
2. Is this all wrong and shoud I use a different approch?
HELP please


Herman
Say no to macros

 

[Andrzejek]

That's not much code.
All what you do with your Ribbon is:

Dim Rib As Office.IRibbonUI
...
Rib.ActivateTab RibName
...

Quick search shows that you need a lot more work (code) to have it working.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[hermanlaksko]

Hi Andy
Thank you for your reply.

As you can see on the top of my code the Rib as dim'd as Office.IRibbonUI but when I reach the last line "Rib.ActivateTab RibName" it says Rib is not set (and therefore Rib = Nothing.)
So how do I set Rib?
Kind regards
Herman


Herman
Say no to macros

 

[Andrzejek]

I would do more search on Ribbon in Access VBA.
One place shows this code:

Option Compare Database
Option Explicit
 [green]
'reference to the MS Office 16.0 Office Library [/green]
Public globalRibbon As IRibbonUI
[green]
'Get a global reference to the ribbon object when the ribbon loads[/green]
Public Sub OnRibbonLoad(ByVal Ribbon As IRibbonUI)[blue]
    Set globalRibbon = Ribbon[/blue]
End Sub

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[strongm]

>it does create the ribbon

it does? How do you know?

I ask because your XML is buggy, and the ribbon should not load correctly.

 

[hermanlaksko]

It does create the ribbon, and its easy to see as it is shown in settings / this database / ribbons.
I have taken the vba code from a similar case that I made in project and it works fine there if it seems buggy well perhaps you are right but it does work and this it not the way it will when I am done.


Herman
Say no to macros

 

[hermanlaksko]

Hi Andy

Thanks for your reply I will give this a try, I have used this methoed before but with no luck so far, but I will give it another try.
Thanks for you help.

Herman
Say no to macros

 

[hermanlaksko]

Strongm
Your comment makes me think that you perpahs have a better example that I can work from
I thank you in asvance.

Herman
Say no to macros

 

[combo]

Have you tried to create and next fill USysRibbons table? You've already have XML, so it can be stored in table, hope that it is possible to activate it programmatically next.
USysRibbons:

https://support.microsoft.com/en-us...n-access-45e110b9-531c-46ed-ab3a-4e25bc9413de

combo

 

[strongm]

Andy's solution will get you a reference to the ribbon if and only if the ribbon loads. And part of your problem is that the ribbon is not actually loading, despite your confidence it is because "its easy to see as it is shown in settings / this database / ribbons". Sadly that is not what that setting means. It simply means that that is the Ribbon definition the database will use when it next opens, not that the ribbon is currently loaded or in use - and it can only do this[sup]*[/sup] if the necessary customisation is defined in a table called USysRibbons. But before you do that you'll need to clean up your ribbon XML.

To see Ribbon XML errors, you need to change an Access setting:

[tt]File -> Options -> Client Settings -> General -> Show add-in user interface errors[/tt] (tick this option)

And there's more. Access seems fussier over the XML than other office apps and the OfficeUI XML schema - for example doesn't like any of the mso stuff (it won't complain about it, just won't work ...), nor does it like some unicode characters such as æ

And you can't put parameters into the OnAction attribute - you can only put the name of the callback function here (and as a result I am surprised you seem to be indicating that "vba code from a similar case that I made in project£ worked fine). Those need to go in the tag attribute instead.


* [small]Actually, in theory you are supposed to be able to achieve something similar through the use of AutoExec running VBA code to build and load the CustomUI, but I have to admit I've never tried this method[/small]

 

[hermanlaksko]

Hi Combo
Yes I know that I have to end in the USysRibbons table, this was only a test , that I originally thourght would be quicker.... obviously it was not

Herman
Say no to macros

 

[hermanlaksko]

Hi Strongm

Thank you for your input that gives me a little light on the matter and points in what I hope is the right direction.
I will try the link provided by both you and Combo



Herman
Say no to macros

 

[strongm]

Had a quiet moment. so here's a version with XML cleaned up so it is legitimate, and is appended to USysRibbons under the name MenuMainRib. A couple of callbacks (but not all) are included.

[COLOR=blue]Sub LetItRipMod()
    Dim RibbonXml As String, A, B, C, RibName, Rib As Office.IRibbonUI
    Dim rs As DAO.Recordset
    
    RibName = "MenuMainRib"
    
    A = Array("&Adgang", "&Skift bruger", "Skift database", "Afslut program", _
    "&Firma F3", "&Brugere", "&Grupper", "&Aktiviteter &", "& Niveauer", _
    "&Centre", "&Vagtkategorier", "&Plantyper", "Outlook", "Skoleoversigt F4", "&Planoversigt F5", "&Vagtoversigt F6", "&Aktivitetsoversigt F7", _
    "National planning", "&Luk alle vinduer F12", "F-Taster", "&Versions info", "&Om Studievalg Danmark") [COLOR=green]'Button names[/color]
    
    B = Array("OpenAny", "OpenAny", "OpenAny", "AslutPrg", _
    "F3", "OpenAny", "OpenAny", "OpenAny", "OpenAny", "OpenAny", "OpenAny", _
    "", "F4", "F5", "F6", "F7", "CloseAllForms", "OpenAny", "OpenAny") [COLOR=green]' Action (callback) on button press[/color]
    
    C = Array("UserAdmin", "Login,False,False", "SkiftDatabase,True,false,True", "AslutPrg", _
    "F3", "UserOverview", "Grupper", "ArrangementListe", "Centre", "VagtKategori", "PTyper", _
    "Empty", "F4", "F5", "F6", "F7", "CloseAllForms", "Empty", "Z_VerHist", "About") [COLOR=green]' Parameters[/color]
    
    RibbonXml = "<?xml version='1.0' encoding='UTF-8'?>"
    RibbonXml = RibbonXml + "<customUI xmlns='[URL unfurl="true"]http://schemas.microsoft.com/office/2009/07/customui'[/URL] onLoad='OnRibbonLoad' >"
    RibbonXml = RibbonXml + "<ribbon startFromScratch='false'><tabs><tab id='Tools' label='" & RibName & "' insertBeforeQ='TabFormat' >"
    
    [COLOR=green]'Knapper i grp 1 - Filer[/color]
    RibbonXml = RibbonXml + "<group id='Filer' label='Brugere / database' autoScale='true' >"
    RibbonXml = RibbonXml + " <button id='ButtonGroup1' label='" & A(0) & "' screentip='Slet personer ikke brugt' supertip='1' onAction='" & B(0) & "' tag='" & C(0) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup2' label='" & A(1) & "' screentip='Gem Publish og Luk' onAction='" & B(1) & "' tag='" & C(1) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup3' label='" & A(2) & "' screentip='Reset' onAction='" & B(2) & "' tag='" & C(2) & "'/>"
    RibbonXml = RibbonXml + "</group>"
    
   [COLOR=green] 'Knapper i grp 2 - Opsætning[/color]
    RibbonXml = RibbonXml + "<group id='Opset' label='Indstillinger'>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup4' label='" & A(3) & "' screentip='Reset' onAction='" & B(3) & "' tag='" & C(3) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup5' label='" & A(4) & "' screentip='Reset' onAction='" & B(4) & "' tag='" & C(4) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup6' label='" & A(5) & "' screentip='Reset' onAction='" & B(5) & "' tag='" & C(5) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup7' label='" & A(6) & "' screentip='Reset' onAction='" & B(6) & "' tag='" & C(6) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup8' label='" & A(7) & "' screentip='Reset' onAction='" & B(7) & "' tag='" & C(7) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup9' label='" & A(8) & "' screentip='Reset' onAction='" & B(8) & "' tag='" & C(8) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup10' label='" & A(9) & "' screentip='Reset' onAction='" & B(9) & "' tag='" & C(9) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup11' label='" & A(10) & "' screentip='Reset' onAction='" & B(10) & "' tag='" & C(10) & "'/>"
    RibbonXml = RibbonXml + "</group>"
    
    [COLOR=green]'Knapper i grp 2 - Oversigter[/color]
    RibbonXml = RibbonXml + "<group id='Oversigter' label='Datalister' autoScale='true'>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup12' label='" & A(11) & "' screentip='Institutionsoversigt' onAction='" & A(11) & "' tag='" & C(11) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup13' label='" & A(12) & "' screentip='Udskriv tilsyn til PDF' onAction='" & A(12) & "' tag='" & C(12) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup14' label='" & A(13) & "' screentip='Vis udskrift for ressource' onAction='" & A(13) & "' tag='" & C(13) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup15' imageMso='MicrosoftVisualFoxPro' screentip='Fox' onAction='" & A(14) & "' tag='" & C(14) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup16' imageMso='SlideNew' screentip='2' onAction='" & A(15) & "' tag='" & C(15) & "'/>"
    RibbonXml = RibbonXml + "</group>"
    
    [COLOR=green]'Knapper i grp 2[/color]
    RibbonXml = RibbonXml + "<group id='Help' label='ABC' autoScale='true'>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup17' label='" & A(16) & "' screentip='Udskriv planer for tilsyn' onAction='" & A(16) & "' tag='" & C(16) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup18' label='" & A(17) & "' screentip='Udskriv tilsyn til PDF' onAction='" & A(17) & "' tag='" & C(17) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup19' label='" & A(18) & "' screentip='Vis udskrift for ressource' onAction='" & A(18) & "' tag='" & C(18) & "'/>"
    RibbonXml = RibbonXml + " <button id='ButtonGroup20' imageMso='MicrosoftVisualFoxPro' screentip='Fox' onAction='" & A(19) & "' tag='" & C(19) & "'/>"
    RibbonXml = RibbonXml + "</group>"
    RibbonXml = RibbonXml + "</tab></tabs></ribbon></customUI>"
      
    Set rs = CurrentDb.OpenRecordset("USysRibbons") [COLOR=green]' Assumes existence of USysRibbons[/color]
        
    rs.AddNew
    rs("RibbonName").Value = RibName
    rs("RibbonXML") = RibbonXml
    rs.Update
    
     [COLOR=green]' now you need to make sure RibName is selected in File > Options > Current Database > Ribbon and TRoolbar Options > Ribbon Name
     ' then close and reopen  database to take effect[/color]
End Sub

Public Sub OnRibbonLoad(ribbon As IRibbonUI)
    MsgBox "Custom ribbon started"
End Sub

Public Sub OpenAny(ByVal control As Office.IRibbonControl)
    MsgBox control.Id & ": " & control.Tag
End Sub
[/color]

 

[hermanlaksko]

WOW - Strongm
Thank you so much, I will try that right away.

Herman
Say no to macros