ribbon generation in excel

Hello,

I wanted to generate a nice ribbon in excel with just VBA.

I like jagged / nested arrays.

Si here is my code to generate a ribbon in excel in vba:

It generate only one tab of a personalized ribbon called "Tables et dessins"
This tab contain id, name and groups (array)
These groups contains id, name and buttons (array)
These buttons contain id, label, on action (sub to execute when pressed), color (or image)

After executing the sub LoadCustRibbon2, you must restart excel for the ribbon to appear cause excel need to load the file.


--------------------- code excel 2010 or 2013 VBA 64 bits ----------------------

'=== ajout boutons
Sub LoadCustRibbon2()
    'http://stackoverflow.com/questions/8850836/how-to-add-a-custom-ribbon-tab-using-vba
 
    Dim hFile As Long
    Dim path As String, fileName As String, ribbonXML As String, user As String
 
    '=== location of the custom ribbon file in the user profile
    hFile = FreeFile
    user = Environ("Username")
    path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
    fileName = "Excel.officeUI"
 
    '=== id, label, on action, color
    buttons0000 = Array("rearrangetable", "Ajuster la table sur cette feuille", "autofit_table_data", "AppointmentColor2")
 
    '=== id, label
    groups00 = Array("Tables", "Tables", buttons0000)
 
    '=== id, label, on action, color
    buttons0100 = Array("addthistodrawing", "Ajouter la selection a la feuille Donnees_Dessin", "add_line_in_drawings", "AppointmentColor3")
    buttons0101 = Array("drawgeomaticgrid", "Dessiner sur la feuille Dessin les donnees dans Donnees_Dessin", "geo_grid_generation", "AppointmentColor4")
     
    '=== id, label
    groups01 = Array("Dessin", "Dessin", buttons0100, buttons0101)
 
    '=== id, label, on action, color
    buttons0200 = Array("generatesheets", "Genere feuille pour chaque ligne avec hyperlien", "sheet_generation", "AppointmentColor5")
 
    groups02 = Array("Feuilles", "Feuilles", buttons0200)
 
    '=== id, label
    tabs01 = Array("TablesandDrawing", "Tables et Dessins", groups00, groups01, groups02)
 
    '=== data
 
    ribbonXML = "" & vbNewLine
    ribbonXML = ribbonXML + "  " & vbNewLine
    ribbonXML = ribbonXML + "    " & vbNewLine
    ribbonXML = ribbonXML + "    " & vbNewLine

    ribbonXML = ribbonXML + "      " & vbNewLine
 
    For grocnt01 = 2 To UBound(tabs01) '=== elements 2 and more are arrays
        group01 = tabs01(grocnt01)
        ribbonXML = ribbonXML + "                ribbonXML = ribbonXML + "label='" & group01(1) & "' autoScale='true'>" & vbNewLine
     
        For butcnt01 = 2 To UBound(group01) '=== elements 2 and more are arrays
            button01 = group01(butcnt01)
            ribbonXML = ribbonXML + "                      ribbonXML = ribbonXML + "label='" & button01(1) & "' " & vbNewLine
            ribbonXML = ribbonXML + "imageMso='" & button01(3) & "'      onAction='" & button01(2) & "'/>" & vbNewLine
        Next 'butcnt01
        ribbonXML = ribbonXML + "        " & vbNewLine
     
    Next 'grocnt01
    ribbonXML = ribbonXML + "    
" & vbNewLine 
    ribbonXML = ribbonXML + "  
" & vbNewLine    ribbonXML = ribbonXML + "
" & vbNewLine    ribbonXML = ribbonXML + "
" 
    ribbonXML = Replace(ribbonXML, """", "")
 
    test = 0
    If test = 0 Then
        Open path & fileName For Output Access Write As hFile
        Print #hFile, ribbonXML
        Close hFile
    Else
        MsgBox (ribbonXML)
    End If
 
End Sub