Sub XMLCreator()
Dim myEncodeXml$, myRibbonUI$, myRibbonUI14$, myRibbon$, StartUI$, StartUI14$, EndBalise$
Dim CheckBalise, BaliseClose, VA, x%, Col_Xml As New Collection, V$, TrueFalse As Boolean, MyIndent$, Col
Dim myUI$, myUI14$
'---------------------------------
myEncodeXml = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>"
myRibbonUI = "<customUI xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"
myRibbonUI14 = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">"
myRibbon = "<ribbon startFromScratch=""false"">"
'---------------------------------
StartUI = myEncodeXml & vbNewLine & myRibbonUI & vbNewLine & vbTab & myRibbon & vbNewLine & Application.Rept(vbTab, 2) & "</tabs>"
StartUI14 = myEncodeXml & vbNewLine & myRibbonUI14 & vbNewLine & vbTab & myRibbon & vbNewLine & Application.Rept(vbTab, 2) & "</tabs>"
EndBalise = Application.Rept(vbTab, 2) & "</tabs>" & vbNewLine & vbTab & "</ribbon>" & vbNewLine & "</customUI>"
'---------------------------------
CheckBalise = Array("TAB", "GROUP", "BUTTONGROUP", "MENU", "BOX", "SPLITBUTTON")
BaliseClose = Array("</tab>", "</group>", "</buttonGroup>", "</menu>", "</box>", "</splitButton>")
'---------------------------------
VA = Sheets("XML CREATION").Range("MyXML[[BALISE TYPE]:[ATTRIBUT 6]]").Value
TrueFalse = False
x = -1
For i = LBound(VA) To UBound(VA)
Check = Application.Match(VA(i, 1), CheckBalise, 0): If IsError(Check) Then Err.Clear: Check = 0
If Check > 2 And x > 1 Then
x = x - 1
Else
If TrueFalse = True And Check > 0 Then x = 0: TrueFalse = False
End If
V = Replace(Replace(Application.Trim(Join(Application.Index(VA, i, [{3,4,5,6,7,8}]))), " />", "/>"), " >", ">")
MyIndent = Application.Rept(vbTab, x + 4)
If Check > 0 Then
If x = -1 Then
Col_Xml.Add MyIndent & V
Col_Xml.Add MyIndent & BaliseClose(Check - 1)
x = x + 1
Else
Col_Xml.Add MyIndent & V, , Col_Xml.Count - x
Col_Xml.Add MyIndent & BaliseClose(Check - 1), , Col_Xml.Count - x
x = x + 1
End If
Else
Col_Xml.Add MyIndent & V, , Col_Xml.Count - x
TrueFalse = True
End If
Next
For Each Col In Col_Xml
myUI = myUI & Col & vbNewLine
myUI14 = myUI14 & Col & vbNewLine
Next
myUI = StartUI & vbNewLine & myUI & EndBalise
myUI14 = StartUI14 & vbNewLine & myUI14 & EndBalise
Debug.Print myUI & vbNewLine & vbNewLine & myUI14
End Sub
, ca me permettra d'avancer et de compléter mon code par la même occasion
