Create groupable tables in PowerPoint with VBA

Question

By changing <a:graphicFrameLocks noGrp="1"/> to <a:graphicFrameLocks noGrp="0"/> as per OOXML Hacking: Locking Graphics's article, it is possible to quickly enable the grouping of tables in a slide, allowing a multitude of possible different uses otherwise unthinkable. There are in fact many more attributes, normally unavailable, and they can be changed for placeholders as well, or for common shapes. Is it possible to create tables with that simple setting enabled? Or, just as for the Custom Colors here and here, they are unavailable through VBA means and it would be easier to either:

• leave one table of this kind in a slide and copy/paste, resize/populate when needed with VBA code, as normal (thus avoiding .AddTable)
• modify existing files through XSLT (by placing all the content of ppt>slides> in a folder, by invoking an .xsl file and the re-adding the slides.xml back to the folder and so on) and turn the switch on

Leaving aside the copy/paste, transforming manually the the table manually in the .xml is not complicated (now I am trying to setup the XSLT but I need help for that), what I am asking is if it is possible to do it programatically with VBA (there are other shapes such as the placeholders that can be tweaked, and other locks available) and where to look for: Google returns only three results with "<a:graphicFrameLocks noGrp="0"/> VBA" as search text and, apart from the above linked OOXML guide, the only other result is openpyxl (in terms of editability, here the official documentation). At page 144, in fact, if I understand correctly the property is editable through a class: "class openpyxl.drawing.graphic.NonVisualGraphicFrameProperties". I wonder if the same could be done in VBA

Update 1

I could find some more information with "vba graphicFrameLocks" as search text, but for C#, for Python, and for .NET (line 46), nothing for VBA.

Update 2

The below VBA code succesfully changes the "1" to "0" , but it is not doing it through XSLT, a simple Replace() is used. That is why I am not posting it as an answer, because it leaves out the possibility of properly editing the file according to a logic (if it's a placeholder or a particular shape, if different attributes have to be changed etc.), rather than brute force.I will play around with Replace() and see what can be done, I reckon it should be possible to add/remove stuff as long as I do not touch the full tag (and the delimiters < or >). This is not what intended, but can work for the moment.

Sub Edix_XML_Of_SLidesAsIf_Txt()

    Dim StrFileName As String
    Dim StrFolder As String
    Dim StrFolderTarget As String
    Dim sBuf As String
    Dim sTemp As String
    Dim sFileName As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder where the XML slide files are stored"
        If .Show = -1 Then
            StrFolder = .SelectedItems(1) & "\"
        End If
    End With
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder where the modified XML slide files should be stored"
        If .Show = -1 Then
            StrFolderTarget = .SelectedItems(1) & "\"
        End If
    End With
    
    StrFileName = Dir(StrFolder & "*.xml")
    
    Do While StrFileName <> ""
        Open StrFolder & StrFileName For Input As #1
        sTemp = ""
        Do Until EOF(1)
            Line Input #1, sBuf
            ' Perform the text replacement here using InStr and concatenation
            Dim startPos As Long
            startPos = InStr(1, sBuf, "graphicFrameLocks noGrp=""1""")
            If startPos > 0 Then       
            
                sBuf = Replace(sBuf, "1", "0")
            End If
            sTemp = sTemp & sBuf & vbCrLf
        Loop
        Close #1
        
        Open StrFolderTarget & StrFileName For Output As #2
        Print #2, sTemp
        Close #2
        
        StrFileName = Dir
    Loop

End Sub

Update 3

I have figured out how to edit slides in bulk directly in the .xml, and planning to add the possibility to choose the tables by name. I suppose the same .xsl can be edited to include also the layout files and, also, create the custom colors (after all, that is just a group to be added).

The above linked .xsl can be invoked from VBA with the following, which will give a file with tables that can be grouped (no rotation, it does not work) and other attributes can be added. I tried noMove and it worked: the tables could be grouped but they would stay in place (that is, the .Top and .Left were stuck, the actual cells could be redeminsioned based on the content).

Sub Edix_XML_Of_SLides_GroupableALL_TabLes()

    Dim StrFileName As String
    Dim StrFolder As String
    Dim StrFolderTarget As String
    Dim xmldoc As Object
    Dim xsldoc As Object
    Dim newdoc As Object
    Dim sBuf As String
    Dim sTemp As String
    Dim sFileName As String
    Dim FileExt(2) As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder where the vector files are stored"
        If .Show = -1 Then
            StrFolder = .SelectedItems(1) & "\"
        End If
    End With
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder where the edited vector files should be stored"
        If .Show = -1 Then
            StrFolderTarget = .SelectedItems(1) & "\"
        End If
    End With
    
    StrFileName = Dir(StrFolder & "*.xml")
    
    Do While StrFileName <> ""
        Set xmldoc = CreateObject("MSXML2.DOMDocument")
        Set xsldoc = CreateObject("MSXML2.DOMDocument")
        Set newdoc = CreateObject("MSXML2.DOMDocument")
        
        'Load XML
        xmldoc.async = False
        xmldoc.Load StrFolder & StrFileName
        
        'Load XSL
        xsldoc.async = False
        xsldoc.Load StrFolder & "GroupTablesOOXML.xsl"
        
        'Transform
        xmldoc.transformNodeToObject xsldoc, newdoc
        newdoc.Save StrFolderTarget & StrFileName
        
        StrFileName = Dir
    Loop
    
    Dim FileExtCount As Integer
    FileExtCount = 2
    FileExt(1) = "xml"
    FileExt(2) = "xml"
    
    Dim i As Integer
    
    For i = 1 To FileExtCount
        sFileName = Dir(StrFolderTarget & "*." & FileExt(i))
        
        Do While sFileName <> ""
            sTemp = ""
            Open StrFolderTarget & sFileName For Input As #1
            Do Until EOF(1)
                Line Input #1, sBuf
                sTemp = sTemp & sBuf & vbCrLf
            Loop
            Close #1
            
            sTemp = Replace(sTemp, "Item", "")
            
            Open StrFolderTarget & sFileName For Output As #1
            Print #1, sTemp
            Close #1
            
            sFileName = Dir
        Loop
    Next i

End Sub

Update 4

This, however, does not really solve the issue, because, while it can be used to transform existing tables in presentations, the second method (through XSLT) requires all the burden of having to go through the renaming-to-zip/extract/etc... with the file closed (for that matter, maybe it would be more useful the first method proposed: leave one "magic" table and clone it at will). What I would like would be to have the possibility to chose if the table, the placeholder and so on, time by time (at creation, during manual/coded editing), should or not have this extra features that are completely hidden from VBA.

Which leads to what is probably the real question behind this one: is there any chance to access the .xml of the presentations with VBA, as it seems to be possible with other programs (and "live")?

Update 5

This looks promising: an Excel file could store different values for the various attributes, and it could be used to apply them accordingly slide.xml by slide.xml.

Update 6

I cannot believe I missed this... and this: the second being a set of macros to do all the boring part to transform pptx to zip and back.

Answer 1

Although this is not "live", working on the current slide/presentation, it's much simpler than invoking the XSLT. In fact, once accustomed with the XML of the slide, the logic of PowerPoint is still there, with all its nested objects.

This helped, and this (from the question) could be the basis to automate it properly.

The below successfully changes enable the unlocking of grouping to the first table of a slide (what directed me were here) and here, while from here there are indications about how to setup loops through the XML.

Sub edit_sL_XML()

Dim xLAppL As Excel.Application: Set xLAppL = GetObject(, "Excel.Application")
Dim wBTrgt As Excel.Workbook: Set wBTrgt = xLAppL.ActiveWorkbook
Dim oXMLFile As Object: Set oXMLFile = CreateObject("Microsoft.XMLDOM")
Dim XMLFileName As String: XMLFileName = xLAppL.GetOpenFilename(Title:="Please choose XML-file with Load Case definitions", FileFilter:="XML Files *.xml (*.xml),")

oXMLFile.Load (XMLFileName)

Dim xmL_sL As MSXML2.IXMLDOMElement: Set xmL_sL = oXMLFile.SelectSingleNode("p:sld")
 'Once the Slide is set

'search for the table. Very likely, when in VBA the If HasTable =msoTrue/msoFalse is checked, it refers to the presence of this very namespace
Dim xmL_sL_TbLFind As MSXML2.IXMLDOMElement: Set xmL_sL_TbLFind = oXMLFile.SelectSingleNode("/p:sld/p:cSld/p:spTree/p:graphicFrame/a:graphic/a:graphicData[@uri='http://schemas.openxmlformats.org/drawingml/2006/table']") 
 'A loop could be put here instead to check if the element is a table (here it is pointing directly, while a dummy element could be set instead)

Dim xmL_sL_TbL_Frame As MSXML2.IXMLDOMNode: Set xmL_sL_TbL_Frame = xmL_sL_TbLFind.ParentNode.ParentNode 

Dim xmL_sL_TbL_TbL As MSXML2.IXMLDOMNode: Set xmL_sL_TbL_TbL = xmL_sL_TbL_Frame.ChildNodes(0).ChildNodes(1).Attributes(0)
'Then again, a for loop here through the items (here it is in the kind of locks available) and if they don't exist/they do not have the wanted value then
Dim xmL_sL_TbL_Locks As MSXML2.IXMLDOMNode: Set xmL_sL_TbL_Locks = xmL_sL_TbL_Frame.ChildNodes(0).ChildNodes(1).ChildNodes(0)

'either reset
xmL_sL_TbL_Locks.Attributes.getNamedItem("noGrp").NodeValue = "0" 'reset to 0
Dim xmL_sL_TbL_Locks_No_TbL_Mv As MSXML2.IXMLDOMAttribute: Set xmL_sL_TbL_Locks_No_TbL_Mv = xmL_sL_TbL_Locks.OwnerDocument.createAttribute("noMove") 'xmL_sL_TbL_Locks.Attributes.getNamedItem("noMove").NodeValue = "0"

'or add and assign a value
xmL_sL_TbL_Locks.Attributes.setNamedItem xmL_sL_TbL_Locks_No_TbL_Mv: xmL_sL_TbL_Locks_No_TbL_Mv.Text = "0"

oXMLFile.Save (XMLFileName)

End Sub

Update 2

here a more analytical approach, with a loop to determine if the block belongs to a table. The only thing that really has to be done is to figure out which each of the .xml nodes relates to the slide, and for this it is very helpful to navigate through the elements with the help of the Locals window, that greatly reduced the time to find what I was looking for. And reason why I am attaching some photos to illustrate better how the slide is structured in its source code.

Sub edit_sL_XML_V2()

Dim sL As Slide: Set sL = ActivePresentation.Slides(1)
Dim xLAppL As Excel.Application: Set xLAppL = GetObject(, "Excel.Application")
Dim wBTrgt As Excel.Workbook: Set wBTrgt = xLAppL.ActiveWorkbook
Dim oXMLFile As Object: Set oXMLFile = CreateObject("Microsoft.XMLDOM")
Dim XMLFileName As String: XMLFileName = xLAppL.GetOpenFilename(Title:="Please choose XML-file with Load Case definitions", FileFilter:="XML Files *.xml (*.xml),")

oXMLFile.Load (XMLFileName)

Dim sL_xmL As MSXML2.IXMLDOMElement: Set sL_xmL = oXMLFile.SelectSingleNode("p:sld")

Dim sH_xmLArr() As MSXML2.IXMLDOMElement: ReDim sH_xmLArr(1 To sL_xmL.ChildNodes.Length) '

Dim z_xmL As Long

For z_xmL = 1 To sL_xmL.ChildNodes.Length
    Set sH_xmLArr(z_xmL) = sL_xmL.ChildNodes(0).ChildNodes(0).ChildNodes(2) ' oXMLFile.SelectSingleNode("/p:cSld/p:spTree/p:graphicFrame") '.ChildNodes.Length)

        Dim sH_xmL_chck As MSXML2.IXMLDOMElement: Set sH_xmL_chck = sH_xmLArr(z_xmL) 'the xml value of a shape
                        
            If Not sH_xmL_chck.ChildNodes(2).ChildNodes(0).Attributes Is Nothing Then
                    Dim tbL_Txt_Check  As String: tbL_Txt_Check = sH_xmL_chck.ChildNodes(2).ChildNodes(0).Attributes.Item(0).Text
            
                    If HasTabLe_XmL(tbL_Txt_Check) = True Then
                            'Do stuff to sH_xmLArr(z_xmL).ChildNodes(0).ChildNodes(1).ChildNodes(0).baseName

                     Debug.Print "Table"
                    End If
            End If

                
Next z_xmL


oXMLFile.Save (XMLFileName)

End Sub



Function HasTabLe_XmL(txt_Input As String) As Boolean
If txt_Input = "http://schemas.openxmlformats.org/drawingml/2006/table" Then
    HasTabLe_XmL = True
Else
    HasTabLe_XmL = False
End If

End Function

Content of the slide, each shape is in its <GraphicFrame> tag.

Content of the array of shapes and path to find locks

How to see if it's a table

Syntax to find the relevant parts.

.xml raw equivalent, with the relevant parts marked: