Pages in this article
-
Worksheet Data
-
Form Controls
-
Edit with VBA
-
Add RibbonX
Adding RibbonX code to an Office OpenXML file using VBA
This article has also been published on Microsoft's MSDN site:
https://msdn.microsoft.com/en-us/library/dd819387.aspx
On the previous page I showed
how to access and modify existing parts of an Office OpenXML package.
This opens up the path for us to add ribbon customisation code to an
Office file. For this to happen, a couple of modifications were needed
to the code in the class module I showed earlier. Fellow Excel MVP
Ken Puls was kind enough to make some modifications to the class
module, which I refined a little. The results are summarised below.
Download
I have made the file used in this article available for download:
EditOpenXML.zip
Modifications to the class module
The class module needed some additions to handle adding CustomUI
code. One of them is a routine that edits the relatationships (.rels)
file in the folder "_rels" to add a reference to a newly inserted
customUI folder. This code edits the .rels file by adding the proper
relationship:
Public Sub
AddCustomUIToRels()
'Date Created : 5/14/2009 23:29
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Add the customUI relationship to
the rels file
Dim oXMLDoc As
MSXML2.DOMDocument
' Dim oXMLElement As MSXML2.IXMLDOMElement
Dim oXMLElement As
MSXML2.IXMLDOMNode
Dim oXMLAttrib As
MSXML2.IXMLDOMAttribute
Dim oNamedNodeMap
As MSXML2.IXMLDOMNamedNodeMap
Dim oXMLRelsList As
MSXML2.IXMLDOMNodeList
'Create a new XML document
Set oXMLDoc = New
MSXML2.DOMDocument
'Attach to the root element of the .rels file
oXMLDoc.Load XMLFolder(XMLFolder_rels) & ".rels"
'Create a new relationship element in the
.rels file
Set oXMLElement =
oXMLDoc.createNode(1, "Relationship", _
"http://schemas.openxmlformats.org/package/2006/relationships")
Set oNamedNodeMap =
oXMLElement.Attributes
'Create ID attribute for the element
Set oXMLAttrib =
oXMLDoc.createAttribute("Id")
oXMLAttrib.NodeValue = "cuID"
oNamedNodeMap.setNamedItem oXMLAttrib
'Create Type attribute for the element
Set oXMLAttrib =
oXMLDoc.createAttribute("Type")
oXMLAttrib.NodeValue =
"http://schemas.microsoft.com/office/2006/relationships/ui/extensibility"
oNamedNodeMap.setNamedItem oXMLAttrib
'Create Target element for the attribute
Set oXMLAttrib =
oXMLDoc.createAttribute("Target")
oXMLAttrib.NodeValue = "customUI/customUI.xml"
oNamedNodeMap.setNamedItem oXMLAttrib
'Now insert the new node at the proper
location
Set oXMLRelsList =
oXMLDoc.SelectNodes("/Relationships")
oXMLRelsList.Item(0).appendChild oXMLElement
'Save the .rels file
oXMLDoc.Save XMLFolder(XMLFolder_rels) & ".rels"
Set oXMLAttrib =
Nothing
Set oXMLElement =
Nothing
Set oXMLDoc =
Nothing
End Sub
Additionally I modified the code that writes XML to a file so it
detects when you're trying to add customUI to the file in question. If
so, it checks if the customUI folder already exists and if not, it adds
it and subsequently updates the aforementioned .rels file:
Public Sub
WriteXML2File(sXML As
String, sFileName As
String, sXMLFolder As XMLFolder)
'-------------------------------------------------------------------------
' Procedure : WriteXML2File
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse
' Created : 6-5-2009
' Purpose : Writes sXML to sFileName
' Modified by Ken Puls 2009-05-12
' Adjusted to add ability to write to
customUI container
'-------------------------------------------------------------------------
Dim oXMLDoc As
MSXML2.DOMDocument
Set oXMLDoc = New
MSXML2.DOMDocument
'If attempting to write a customUI component,
test to see if one exists
'Should probably test the .rels file to see if
the CustomUI relationship exists...
If sXMLFolder = XMLFolder_customUI
Then
If Not
FolderExists(XMLFolder(XMLFolder_customUI)) Then
MkDir XMLFolder(XMLFolder_customUI)
'Write the XML to the file
oXMLDoc.loadXML sXML
oXMLDoc.Save XMLFolder(sXMLFolder) & sFileName
'CustomUI has not been created yet.
Rels file needs to be adjusted
AddCustomUIToRels
End If
End If
'Write the XML to the file
oXMLDoc.loadXML sXML
oXMLDoc.Save XMLFolder(sXMLFolder) & sFileName
End Sub
How to add Custom UI
There is a small demo routine that shows how customUI code is added
to a file. The code below demonstrates what simplicity we got by using a
class module to take care of the dirty work for us:
Public Sub
DemoWritingRibbonXML2File()
'-------------------------------------------------------------------------
' Procedure : Demo
' Company : JKP Application Development Services
(c)
' Author : Jan Karel Pieterse (jkp-ads.com)
' Created : 06-05-2009
' Purpose : Demonstrates Writing RibbonX code to
an Office Open XML package
'-------------------------------------------------------------------------
Dim cEditOpenXML As
clsEditOpenXML
Dim sXML As
String
Set cEditOpenXML =
New clsEditOpenXML
With cEditOpenXML
'Tell it which OpenXML file to process
.SourceFile = ThisWorkbook.Path & "\formcontrols.xlsm"
'Before you can access info in the file,
it must be unzipped
.UnzipFile
'This is the RibbonX code we want to write
to the file
sXML = "<customUI
xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">" & _
"<ribbon startFromScratch=""false"">" & _
"<tabs>" & _
"<tab id=""customTab"" label=""Custom Tab"">" & _
"<group id=""customGroup"" label=""Custom Group"">" & _
"<button id=""customButton"" label=""Custom Button""
imageMso=""HappyFace"" size=""large"" onAction=""Callback"" />" & _
"</group>" & _
"</tab>" & _
"</tabs>" & _
"</ribbon>" & _
"</customUI>"
'Now write the xml to the file
'(the class takes care of the relationships for us):
.WriteXML2File sXML, "customUI.xml", XMLFolder_customUI
'Now rezip the unzipped package
.ZipAllFilesInFolder
End With
'Only when you let the class go out of scope
the zip file's
'.zip extension is removed
'in the terminate event of the class.
'Then the OpenXML file has its original
filename back.
Set cEditOpenXML =
Nothing
End Sub
Conclusion
The code shown in this article and
in the associated download file shows you a way to add RibbonX
customisation to an Office 2007 OpenXML file using VBA. This enables us
to update ribbonX code inside an existing Excel file on-the-fly, which
is normally impossible.