Challenging cross-version code (Ribbon)

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,806
Office Version
  1. 2016
Platform
  1. Windows
Suppose we have a workbook with the FileFormat xlExcel8 which is the file format that is fully compatible with excel 97-2003.

Now , let's say the file runs some code to disable the Save commandbar control.

There are two possible scenarios :

1- If the workbook happens to be opened in excel 2003 or earlier then the code to disable the Save control is easy as follows:

Code:
Application.CommandBars.FindControl(, ID:=3).Enabled = False
2- If the workbook is however opened in excel 2007 then the code to disable the Save Control is XML based and the above code will obviously not work.

Question :

Is there a way to have some generic code that will detect in advance the current excel version and then run the code to disable the Save control accordingly ?
 
Looks like we might have a show stopper here. According to this we'd need MSXML.4.0 or > on the system to manipulate xml through vba, which could be a problem if you you are going to release the wb.

edit: see also this (1st answer)
 
Last edited:
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Looks like we might have a show stopper here. According to this we'd need MSXML.4.0 or > on the system to manipulate xml through vba, which could be a problem if you you are going to release the wb.

edit: see also this (1st answer)

Thanks again for the interest. - I already came accross this MSXML library while searching . I'll take a closer look at it.
 
Upvote 0
Ok. I seem to have managed to program the Ribbon from a 97-2003 fileformat workbook opened in xl 2007 - all done with VBA. ( in this example, I just show how to disable the Save Button but the same approach could easily be extended to code the Ribbon more extensively.)

It is crude programming as the code first saves the workbook from .xls into .xlsm , unzip the workbook, creates the CustomUI.xlm file and updates the .rels file from the byte arrays and finally zips back the workbook.

I have tested it and it works pretty well. I hope it works for you as well.

Workbook demo.


here is the entire project code in case the above workbook link expires :

1- Add a new Standard module to the VB Project (basXL2007) and place the following code in it :

Code:
Option Explicit

Public Declare Function LockWindowUpdate Lib "user32.dll" _
(ByVal hwndLock As Long) As Long

Public Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)


'-----------------
'Public routines '
'-----------------

Public Sub DisableSaveFile_XL2007()
 
    If ThisWorkbook.FileFormat = xlExcel8 Then
        Call SetUpVBSFile
        Call ConvertFileFormat
    End If
 
 End Sub
 
 
Public Sub UpdateRibbon_Now(Dummy As Boolean)

    Application.ScreenUpdating = False
    
    With ThisWorkbook
        .ChangeFileAccess xlReadOnly
        Call Create_CustomUI_And_Rels_Files(ThisWorkbook)
        Workbooks.Open .FullName
        .Close False
    End With

End Sub

Public Sub RestoreFileFormat()


    On Error Resume Next

    With ThisWorkbook
        If .FileFormat <> xlExcel8 Then
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            .Saved = False
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .SaveAs .Path & "\" & _
            Left(.Name, InStrRev(.Name, ".") - 1) & ".xls", xlExcel8
        End If
    End With

End Sub
 
 
'-----------------
'Private routines '
'-----------------
 
Private Sub SetUpVBSFile()

    Dim sTempVBS As String
    Dim sXLSMPathName As String
    
    sTempVBS = Environ("Temp") & "\temp.vbs"
    
    sXLSMPathName = ThisWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & ".xlsm"
    
    Open sTempVBS For Output As #1
    Print #1, "On Error Resume Next"
    Print #1, "set wb=Getobject(" & Chr(34) & sXLSMPathName & Chr(34) & ")"
    Print #1, "Do"
    Print #1, "set wb=Getobject(" & Chr(34) & sXLSMPathName & Chr(34) & ")"
    Print #1, "If TypeName(wb)=" & Chr(34) & "Workbook" & Chr(34) & "Then exit Do"
    Print #1, "Loop"
    Print #1, "wb.UpdateRibbon True"
    Print #1, "Set wb=Nothing"
    Close #1
    
    Do
        DoEvents
    Loop Until Len(Dir(sTempVBS)) <> 0
    
    'run the background vbs file.
    Call Shell("WScript.exe " & sTempVBS)

End Sub

Private Sub ConvertFileFormat()

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        LockWindowUpdate .Hwnd
    End With
    
    With ThisWorkbook
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .SaveAs .Path & "\" _
        & Left(.Name, InStrRev(.Name, ".") - 1) & ".xlsm", xlOpenXMLWorkbookMacroEnabled
        Workbooks.Open .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & ".xlsm"
    End With

End Sub


Private Sub Create_CustomUI_And_Rels_Files(wb As Workbook)

    Dim oFso As Object
    
    On Error Resume Next
    
    Name wb.FullName _
    As Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip"
    MkDir wb.Path & "\TempFolder"
    Zip_Activity "UNZIP", Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip" _
    , wb.Path & "\TempFolder"
    MkDir wb.Path & "\TempFolder\customUI"
    Call CreateFiles(wb.Path & "\TempFolder\CustomUI\customUI.xml", _
    wb.Path & "\TempFolder\_rels\.rels")
    Zip_Activity "ZIPFOLDER", wb.Path & "\TempFolder", wb.FullName
    Kill Left(wb.FullName, InStrRev(wb.FullName, ".") - 1) & ".zip"
    Set oFso = CreateObject("Scripting.FileSystemObject")
    oFso.DeleteFolder wb.Path & "\TempFolder", True
    Name wb.FullName & ".zip" As wb.FullName

End Sub


Private Sub CreateFiles(CustomUI As String, Rels As String)

    Dim x As Long
    Dim FileNum As Long
    Dim bytes() As Byte
    Dim arCustomUI_Bytes()
    Dim arRels_Bytes()


    arCustomUI_Bytes = Array(10, 60, 99, 117, 115, 116, 111, 109, 85, 73, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, 111, 109, 47, 111, 102, 102, _
    105, 99, 101, 47, 50, 48, 48, 54, 47, 48, 49, 47, 99, 117, 115, 116, 111, 109, 117, 105, 34, 62, 10, 10, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 32, 32, 32, 32, 60, 33, 45, 45, 32, 68, 195, 169, 115, 97, 99, 116, 105, 118, 101, 32, 108, _
    101, 32, 98, 111, 117, 116, 111, 110, 32, 34, 67, 111, 117, 108, 101, 117, 114, 32, 100, 101, 32, 114, 101, 109, 112, 108, 105, 115, 115, 97, 103, 101, 34, 32, 45, 45, 62, 10, 32, 32, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 32, 105, 100, 77, _
    115, 111, 61, 34, 70, 105, 108, 101, 83, 97, 118, 101, 34, 32, 101, 110, 97, 98, 108, 101, 100, 61, 34, 102, 97, 108, 115, 101, 34, 32, 47, 62, 10, 32, 32, 60, 47, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 10, 60, 114, 105, 98, 98, 111, 110, 32, 115, _
    116, 97, 114, 116, 70, 114, 111, 109, 83, 99, 114, 97, 116, 99, 104, 61, 34, 102, 97, 108, 115, 101, 34, 62, 10, 10, 60, 47, 114, 105, 98, 98, 111, 110, 62, 10, 60, 47, 99, 117, 115, 116, 111, 109, 85, 73, 62, 10)
    
    arRels_Bytes = Array(239, 187, 191, 60, 63, 120, 109, 108, 32, 118, 101, 114, 115, 105, 111, 110, 61, 34, 49, 46, 48, 34, 32, 101, 110, 99, 111, 100, 105, 110, 103, 61, 34, 117, 116, 102, 45, 56, 34, 63, 62, 60, 82, 101, 108, _
    97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, _
    116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 34, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, _
    112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, _
    111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 101, 120, 116, 101, 110, 100, 101, 100, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, _
    114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, 115, 47, 97, 112, 112, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 51, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, _
    101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, _
    97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 109, 101, 116, 97, 100, 97, 116, 97, 47, 99, 111, 114, 101, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, _
    115, 47, 99, 111, 114, 101, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 50, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, _
    101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, _
    110, 115, 104, 105, 112, 115, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 120, 108, 47, 119, 111, 114, 107, 98, 111, 111, 107, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, _
    73, 100, 49, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, _
    111, 109, 47, 111, 102, 102, 105, 99, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 117, 105, 47, 101, 120, 116, 101, 110, 115, 105, 98, 105, 108, 105, 116, 121, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 47, 99, 117, 115, 116, 111, _
    109, 85, 73, 47, 99, 117, 115, 116, 111, 109, 85, 73, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 82, 100, 56, 102, 49, 52, 57, 50, 97, 52, 97, 97, 102, 52, 102, 53, 98, 34, 32, 47, 62, 60, 47, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 62)


    ReDim bytes(LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes))

    For x = LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes)
        bytes(x) = CByte((arCustomUI_Bytes(x)))
    Next

    FileNum = FreeFile
     Open CustomUI For Binary As #FileNum
    Put #FileNum, 1, bytes
    Close FileNum

        ReDim bytes(LBound(arRels_Bytes) To UBound(arRels_Bytes))
    For x = LBound(arRels_Bytes) To UBound(arRels_Bytes)
        bytes(x) = CByte(arRels_Bytes(x))
    Next

    FileNum = FreeFile
    Open Rels For Binary As #FileNum
        Put #FileNum, 1, bytes
    Close FileNum

End Sub
2- Add another Standard Module (basXL97_2003) and place in it the following :

Code:
Option Explicit

Public Sub DisableSaveFile_XL97_2003()
    Application.CommandBars.FindControl(, ID:=3).Enabled = False
End Sub
3- Add yet another Standard module (basZipCode) and put the following code in it :

Code:
Option Explicit

'//source was in C# from urls:
'//http://www.codeproject.com/csharp/CompressWithWinShellAPICS.asp
'//http://www.codeproject.com/csharp/DecompressWinShellAPICS.asp


Public Sub Zip_Activity(Action, sFileSource, sFileDest)

    '//copies contents of folder to zip file
    Dim ShellClass
    Dim Filesource
    Dim Filedest
    Dim Folderitems
    
     Set ShellClass = CreateObject("Shell.Application")
     
    If sFileSource = "" Or sFileDest = "" Then GoTo EH
                
    Select Case UCase$(Action)
        
        Case "ZIPFILE"

            If Right$(UCase$(sFileDest), 4) <> ".ZIP" Then
                sFileDest = sFileDest & ".ZIP"
            End If

            If Not Create_Empty_Zip(sFileDest) Then
                GoTo EH
            End If

            Set Filedest = ShellClass.Namespace(sFileDest)
            Call Filedest.CopyHere(sFileSource, 20)

        Case "ZIPFOLDER"

            If Right$(UCase$(sFileDest), 4) <> ".ZIP" Then
                sFileDest = sFileDest & ".ZIP"
            End If

            If Not Create_Empty_Zip(sFileDest) Then
                GoTo EH
            End If

            '//Copy a folder and its contents into the newly created zip file
            Set Filesource = ShellClass.Namespace(sFileSource)
            Set Filedest = ShellClass.Namespace(sFileDest)
            Set Folderitems = Filesource.Items
            Call Filedest.CopyHere(Folderitems, 20)
        
        Case "UNZIP"
            
            If Right$(UCase$(sFileSource), 4) <> ".ZIP" Then
                sFileSource = sFileSource & ".ZIP"
            End If
            Set Filesource = ShellClass.Namespace(sFileSource)  '//should be zip file
            Set Filedest = ShellClass.Namespace(sFileDest)      '//should be directory
            Set Folderitems = Filesource.Items                  '//copy zipped items to directory
            Call Filedest.CopyHere(Folderitems, 20)
        
        Case Else
        
    End Select
            
    '//Ziping a file using the Windows Shell API creates another thread where the zipping is executed.
    '//This means that it is possible that this console app would end before the zipping thread
    '//starts to execute which would cause the zip to never occur and you will end up with just
    '//an empty zip file. So wait a second and give the zipping thread time to get started.

    Call Sleep(100)
    
EH:

    If Err.Number <> 0 Then
        MsgBox Err.Description & "hkhjhjh", vbExclamation, "error"
    End If

    Set ShellClass = Nothing
    Set Filesource = Nothing
    Set Filedest = Nothing
    Set Folderitems = Nothing

End Sub

Private Function Create_Empty_Zip(sFileName) As Boolean

    Dim EmptyZip()  As Byte
    Dim J           As Integer

    On Error GoTo EH
    Create_Empty_Zip = False

    '//create zip header
    ReDim EmptyZip(1 To 22)

    EmptyZip(1) = 80
    EmptyZip(2) = 75
    EmptyZip(3) = 5
    EmptyZip(4) = 6
    
    For J = 5 To UBound(EmptyZip)
        EmptyZip(J) = 0
    Next

    '//create empty zip file with header
    Open sFileName For Binary Access Write As #1

    For J = LBound(EmptyZip) To UBound(EmptyZip)
        Put #1, , EmptyZip(J)
    Next
    
    Close #1

    Create_Empty_Zip = True

EH:
    
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, "Error"
    End If
    
End Function
4- Finally put this code in the Workbook module :

Code:
Option Explicit

Private Sub Workbook_Open()

    If Val(Application.Version) < 12 Then
        Call DisableSaveFile_XL97_2003
    Else
        Call DisableSaveFile_XL2007
    End If
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    If Val(Application.Version) = 12 Then
        Call RestoreFileFormat
    End If
    
End Sub


'Routine ran by the temp VB script - Must be Public.
Public Sub UpdateRibbon(Dummy As Boolean)

    Application.ScreenUpdating = False
    LockWindowUpdate 0
    Call UpdateRibbon_Now(True)

End Sub
 
Upvote 0
Ok. I seem to have managed to program the Ribbon from a 97-2003 fileformat workbook opened in xl 2007 - all done with VBA. ( in this example, I just show how to disable the Save Button but the same approach could easily be extended to code the Ribbon more extensively.)

It is crude programming as the code first saves the workbook from .xls into .xlsm , unzip the workbook, creates the CustomUI.xlm file and updates the .rels file from the byte arrays and finally zips back the workbook.

I have tested it and it works pretty well. I hope it works for you as well.



Code:
Private Sub CreateFiles(CustomUI As String, Rels As String)

    Dim x As Long
    Dim FileNum As Long
    Dim bytes() As Byte
    Dim arCustomUI_Bytes()
    Dim arRels_Bytes()


    arCustomUI_Bytes = Array(10, 60, 99, 117, 115, 116, 111, 109, 85, 73, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, 111, 109, 47, 111, 102, 102, _
    105, 99, 101, 47, 50, 48, 48, 54, 47, 48, 49, 47, 99, 117, 115, 116, 111, 109, 117, 105, 34, 62, 10, 10, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 32, 32, 32, 32, 60, 33, 45, 45, 32, 68, 195, 169, 115, 97, 99, 116, 105, 118, 101, 32, 108, _
    101, 32, 98, 111, 117, 116, 111, 110, 32, 34, 67, 111, 117, 108, 101, 117, 114, 32, 100, 101, 32, 114, 101, 109, 112, 108, 105, 115, 115, 97, 103, 101, 34, 32, 45, 45, 62, 10, 32, 32, 32, 32, 60, 99, 111, 109, 109, 97, 110, 100, 32, 105, 100, 77, _
    115, 111, 61, 34, 70, 105, 108, 101, 83, 97, 118, 101, 34, 32, 101, 110, 97, 98, 108, 101, 100, 61, 34, 102, 97, 108, 115, 101, 34, 32, 47, 62, 10, 32, 32, 60, 47, 99, 111, 109, 109, 97, 110, 100, 115, 62, 10, 10, 60, 114, 105, 98, 98, 111, 110, 32, 115, _
    116, 97, 114, 116, 70, 114, 111, 109, 83, 99, 114, 97, 116, 99, 104, 61, 34, 102, 97, 108, 115, 101, 34, 62, 10, 10, 60, 47, 114, 105, 98, 98, 111, 110, 62, 10, 60, 47, 99, 117, 115, 116, 111, 109, 85, 73, 62, 10)
    
    arRels_Bytes = Array(239, 187, 191, 60, 63, 120, 109, 108, 32, 118, 101, 114, 115, 105, 111, 110, 61, 34, 49, 46, 48, 34, 32, 101, 110, 99, 111, 100, 105, 110, 103, 61, 34, 117, 116, 102, 45, 56, 34, 63, 62, 60, 82, 101, 108, _
    97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 32, 120, 109, 108, 110, 115, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, _
    116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 34, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, _
    112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, _
    111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 101, 120, 116, 101, 110, 100, 101, 100, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, _
    114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, 115, 47, 97, 112, 112, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 51, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, _
    101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 112, 97, 99, 107, 97, 103, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, _
    97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 109, 101, 116, 97, 100, 97, 116, 97, 47, 99, 111, 114, 101, 45, 112, 114, 111, 112, 101, 114, 116, 105, 101, 115, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 100, 111, 99, 80, 114, 111, 112, _
    115, 47, 99, 111, 114, 101, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, 73, 100, 50, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, _
    101, 109, 97, 115, 46, 111, 112, 101, 110, 120, 109, 108, 102, 111, 114, 109, 97, 116, 115, 46, 111, 114, 103, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, _
    110, 115, 104, 105, 112, 115, 47, 111, 102, 102, 105, 99, 101, 68, 111, 99, 117, 109, 101, 110, 116, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 120, 108, 47, 119, 111, 114, 107, 98, 111, 111, 107, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 114, _
    73, 100, 49, 34, 32, 47, 62, 60, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 32, 84, 121, 112, 101, 61, 34, 104, 116, 116, 112, 58, 47, 47, 115, 99, 104, 101, 109, 97, 115, 46, 109, 105, 99, 114, 111, 115, 111, 102, 116, 46, 99, _
    111, 109, 47, 111, 102, 102, 105, 99, 101, 47, 50, 48, 48, 54, 47, 114, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 47, 117, 105, 47, 101, 120, 116, 101, 110, 115, 105, 98, 105, 108, 105, 116, 121, 34, 32, 84, 97, 114, 103, 101, 116, 61, 34, 47, 99, 117, 115, 116, 111, _
    109, 85, 73, 47, 99, 117, 115, 116, 111, 109, 85, 73, 46, 120, 109, 108, 34, 32, 73, 100, 61, 34, 82, 100, 56, 102, 49, 52, 57, 50, 97, 52, 97, 97, 102, 52, 102, 53, 98, 34, 32, 47, 62, 60, 47, 82, 101, 108, 97, 116, 105, 111, 110, 115, 104, 105, 112, 115, 62)


    ReDim bytes(LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes))

    For x = LBound(arCustomUI_Bytes) To UBound(arCustomUI_Bytes)
        bytes(x) = CByte((arCustomUI_Bytes(x)))
    Next

    FileNum = FreeFile
     Open CustomUI For Binary As #FileNum
    Put #FileNum, 1, bytes
    Close FileNum

        ReDim bytes(LBound(arRels_Bytes) To UBound(arRels_Bytes))
    For x = LBound(arRels_Bytes) To UBound(arRels_Bytes)
        bytes(x) = CByte(arRels_Bytes(x))
    Next

    FileNum = FreeFile
    Open Rels For Binary As #FileNum
        Put #FileNum, 1, bytes
    Close FileNum

End Sub

Interesting Jafar. Could you throw in a pointer to somewhere where i can find out more about the byte arrays?
 
Upvote 0
Interesting Jafar. Could you throw in a pointer to somewhere where i can find out more about the byte arrays?

Thanks for the feedback yytsunamiyy .

Those are just the extracted Bytes of the CustomUI and .rels xml files generated by the Ribbonx which change every time the Ribbon is changed. I would normally store the bytes in a hidden worksheet but in this case , I incorporated them directly into the code because they are realatively small.
 
Upvote 0
I admit I'm in way over my head. Neithertheless, the next logical step for me would be to look for a way that allows me to "translate" a xml command string like:

PHP:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">                                            
                                            
  <!-- Add Custom group to the Home tab in the ribbon-->                                            
  <!-- The example add three buttons to the group and a menu button with 5 options-->                                            
  <!-- Click on the "generate Callbacks" button in the UI editor to create the macro(s)-->                                            
  <!-- You can copy them in a module in your workbook then and add your code-->                                            
                                            
  <ribbon>                                            
    <tabs>                                            
                                            
      <tab idMso="TabHome" >                                            
        <group id="customGroup1" label="Group 1" insertAfterMso="GroupEditingExcel" >                                            
          <button id="customButton1" label="Caption 1" size="normal" onAction="Macro1" imageMso="DirectRepliesTo" />                                            
          <button id="customButton2" label="Caption 2" size="normal" onAction="Macro2" imageMso="AccountMenu" />                                            
          <button id="customButton3" label="Caption 3" size="normal" onAction="Macro3" imageMso="RegionLayoutMenu" />                                            
                                            
      <separator id="MySeparator1" />                                        
                                            
          <menu id="MyDropdownMenu" label="My Menu" size="large" imageMso="TextAlignGallery"  >                                            
            <button id="customButton4" label="Caption 4"  onAction="Macro4" imageMso="TextAlignGallery" />                                            
            <button id="customButton5" label="Caption 5"  onAction="Macro5" imageMso="TextAlignGallery" />                                            
            <button id="customButton6" label="Caption 6"  onAction="Macro6" imageMso="TextAlignGallery" />                                            
            <button id="customButton7" label="Caption 7"  onAction="Macro7" imageMso="TextAlignGallery" />                                            
            <button id="customButton8" label="Caption 8"  onAction="Macro8" imageMso="TextAlignGallery" />                                            
          </menu>                                            
        </group>                                            
      </tab>                                            
                                            
    </tabs>                                            
  </ribbon>                                            
                                            
</customUI>
<customui xmlns="http://schemas.microsoft.com/office/2006/01/customui">which might just as well be written as a continous string without formatting like this:

</customui></customui>
PHP:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"><!-- Add Custom group to the Home tab in the ribbon--><!-- The example add three buttons to the group and a menu button with 5 options--><!-- Click on the "generate Callbacks" button in the UI editor to create the macro(s)--><!-- You can copy them in a module in your workbook then and add your code--><ribbon><tabs><tab idMso="TabHome" ><group id="customGroup1" label="Group 1" insertAfterMso="GroupEditingExcel" ><button id="customButton1" label="Caption 1" size="normal" onAction="Macro1" imageMso="DirectRepliesTo" /><button id="customButton2" label="Caption 2" size="normal" onAction="Macro2" imageMso="AccountMenu" /><button id="customButton3" label="Caption 3" size="normal" onAction="Macro3" imageMso="RegionLayoutMenu" /><separator id="MySeparator1" /><menu id="MyDropdownMenu" label="My Menu" size="large" imageMso="TextAlignGallery"  ><button id="customButton4" label="Caption 4"  onAction="Macro4" imageMso="TextAlignGallery" /><button id="customButton5" label="Caption 5"  onAction="Macro5" imageMso="TextAlignGallery" /><button id="customButton6" label="Caption 6"  onAction="Macro6" imageMso="TextAlignGallery" /><button id="customButton7" label="Caption 7"  onAction="Macro7" imageMso="TextAlignGallery" /><button id="customButton8" label="Caption 8"  onAction="Macro8" imageMso="TextAlignGallery" /></menu></group></tab></tabs></ribbon></customUI>

to the appropriate Byte arrays.

Of course, you could always just record the changes to the byte arrays and hardcode them in vba. But I think it might be more usefull if you could write a "cleartext" xml code string into your vba code that gets interpreted. But then again I might be asking too much. :D
<customui xmlns="http://schemas.microsoft.com/office/2006/01/customui"><customui xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <customui xmlns="http://schemas.microsoft.com/office/2006/01/customui">
</customui></customui></customui>
 
Upvote 0
yytsunamiyy.

I agree with you that having a radeable xml string would look more intuitive than having a bunch of bytes but converting the xml command string into a VBA string is much more difficult & tedious than extracting the bytes of the xml file via a little vba code , storing them somewhere within the workbook or hadcoding them into arrays then recreating the file back from the bytes.

You can still take the route you are suggesting. For example, the following will create the CustomUI.xml file in the C drive from the xml command string you posted above:

<customui xmlns=" & Chr(34) & _<br /> " http:="" schemas.microsoft.com="" office="" 2006="" 01="" customui"="" &="" chr(34)="" "=""><ribbon><tabs><tab idmso=" & Chr(34) & " tabhome"="" &="" chr(34)="" "="">Edit: see code below :
</tab></tabs></ribbon></customui>
 
Upvote 0
Sorry the board refuses to paste the code - I'll post a workbook link in a moment.
 
Upvote 0

Forum statistics

Threads
1,224,620
Messages
6,179,925
Members
452,949
Latest member
beartooth91

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