使用 VBA 在 PowerPoint 中创建可分组表格

Question

通过按照

OOXML Hacking: Locking Graphics

的文章将

<a:graphicFrameLocks noGrp="1"/>

更改为 <a:graphicFrameLocks noGrp="0"/>，可以快速启用幻灯片中的表格分组，从而允许多种可能的不同用途，否则这是不可想象的。事实上，还有更多属性，通常不可用，并且也可以更改占位符或常见形状。是否可以在启用这种简单设置的情况下创建表？或者，就像自定义颜色此处和此处一样，它们无法通过 VBA 方式使用，并且更容易：

• 在幻灯片中保留一张此类表格，并在需要时使用 VBA 代码复制/粘贴、调整大小/填充（从而避免

  .AddTable

  ）
• 通过 XSLT 修改现有文件（通过将 ppt>slides> 的所有内容放在文件夹中，调用 .xsl 文件并将幻灯片.xml 重新添加回文件夹等）并打开开关

抛开复制/粘贴，在 .xml 中手动转换表格并不复杂（现在我正在尝试设置 XSLT，但我需要帮助），我要问的是是否可以使用 VBA 以编程方式执行此操作（还有其他形状，例如可以调整的占位符，以及其他可用的锁）以及在哪里查找：Google 仅返回三个结果，其中“ VBA”作为搜索文本，并且，从上面链接的 OOXML 指南中，唯一的其他结果是 openpyxl（就可编辑性而言，这里官方文档）。在第144页，事实上，如果我理解正确的话，该属性可以通过一个类进行编辑：“class openpyxl.drawing.graphic.NonVisualGraphicFrameProperties”。 我想知道在 VBA 中是否可以完成同样的事情

更新1

我可以使用“vba GraphicFrameLocks”作为搜索文本找到更多信息，但对于 C#、Python 和 .NET（第 46 行），对于 VBA 没有任何信息。

更新2

下面的 VBA 代码成功地将

"1"

更改为

"0"

，但它不是通过 XSLT 完成的，而是使用了简单的

Replace()

。这就是为什么我没有将其作为答案发布，因为它排除了根据逻辑正确编辑文件的可能性（如果它是占位符或特定形状，如果必须更改不同的属性等），而不是我将尝试使用

Replace()

并看看可以做什么，我认为只要我不触摸完整标签（以及分隔符

<

或

>

，就应该可以添加/删除内容）。 这不是预期的，但暂时可以使用。

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

更新3

我已经弄清楚如何直接在.xml中批量编辑幻灯片，并计划添加按名称选择表格的可能性。我想可以编辑相同的 .xsl 以包含布局文件，并创建自定义颜色（毕竟，这只是要添加的组）。

可以使用以下命令从 VBA 调用上面链接的 .xsl，这将提供一个包含可以分组的表的文件（没有旋转，它不起作用）并且可以添加其他属性。我尝试了

noMove

并且成功了：表格可以分组，但它们会保持在原位（也就是说，

.Top

和

.Left

被卡住，实际的单元格可以根据内容重新定义）。

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

更新4

然而，这并不能真正解决问题，因为虽然它可以用于转换演示文稿中的现有表格，但第二种方法（通过 XSLT）需要承担重命名为 zip/提取的所有负担/etc... 文件关闭（就此而言，也许建议的第一种方法更有用：留下一个“神奇”表并随意克隆它）。我希望能够一次又一次地（在创建时、手动/编码编辑期间）选择表格、占位符等是否应该具有对 VBA 完全隐藏的额外功能。

这可能导致这背后的真正问题是什么：是否有机会使用 VBA 访问演示文稿的 .xml，就像其他程序（和“实时”）一样？

更新5

这看起来很有前途：Excel 文件可以存储各种属性的不同值，并且可以用于相应地应用它们幻灯片.xml 到幻灯片.xml。

更新6

我不敢相信我错过了this...和this：第二个是一组宏，用于完成所有无聊的部分，将 pptx 转换为 zip 并返回。

Answer 1

尽管这不是“实时”处理当前幻灯片/演示文稿，但它比调用 XSLT 简单得多。事实上，一旦习惯了幻灯片的 XML，PowerPoint 的逻辑及其所有嵌套对象仍然存在。

[这个][1]有帮助，[这个][2]（来自问题）可能是正确实现自动化的基础。

以下成功更改启用了对幻灯片第一个表格的分组解锁（指导我的是[此处][3]）和[此处][4]，而从[此处][5]有关于如何进行的指示通过 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


  [1]: https://analystcave.com/vba-xml-working-xml-files/
  [2]: https://jkp-ads.com/articles/excel2007fileformat02.asp
  [3]: https://stackoverflow.com/a/41712921/18247317
  [4]: https://stackoverflow.com/a/41038999/18247317
  [5]: https://stackoverflow.com/a/31412085/18247317