用于创建 CustomColors 的十六进制值表的 VBA 代码

Question

我使用 https://www.brandwares.com/bestpractices/2015/06/xml-hacking-custom-colors/ 使用 VBA 在 PowerPoint 中创建自定义颜色。

我想知道如何访问这些自定义颜色并在 PowerPoint 中创建一个彩色表格，其中单元格由相应的自定义颜色着色，并且十六进制值写入单元格中。预先感谢您。

Answer 1

下面将创建主题文件中存在的自定义颜色的数组，然后可以将值存储在某处。可以使用类似的方法来添加颜色。

请注意，要使用它，您必须：

• 将演示文稿的扩展名更改为 .zip（并在提示时单击“是”）
• 输入压缩文件并获取文件

  .zip\ppt\theme

  ，将它们粘贴到其他地方
• 根据需要处理它们
• 将它们放回去（不是你的情况，除非你想修改颜色或其他东西）

Sub ListPowerPointCustomCoLorsV2()

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 tHeme_BLock As MSXML2.IXMLDOMElement: Set tHeme_BLock = oXMLFile.SelectSingleNode("a:theme")
Dim tHeme_BLock_CustomCoLors As MSXML2.IXMLDOMElement: Set tHeme_BLock_CustomCoLors = tHeme_BLock.ChildNodes(3)

Dim customCoLor_XmL() As String: ReDim customCoLor_XmL(1 To tHeme_BLock_CustomCoLors.ChildNodes.Length, 1 To 2) 'customCoLor_XmL_XmL.ChildNodes.Length, 1 To 2)

Dim tHeme_ChiLd_Count As Long

For tHeme_ChiLd_Count = 1 To UBound(customCoLor_XmL) 'tHeme_BLock.ChildNodes.Length

    Dim tHeme_CurrentCoLor As MSXML2.IXMLDOMElement
    Set tHeme_CurrentCoLor = tHeme_BLock_CustomCoLors.ChildNodes(tHeme_ChiLd_Count - 1)
    
    customCoLor_XmL(tHeme_ChiLd_Count, 1) = tHeme_CurrentCoLor.ChildNodes(0).Attributes(0).Text
    customCoLor_XmL(tHeme_ChiLd_Count, 2) = tHeme_CurrentCoLor.Attributes(0).Text

Next tHeme_ChiLd_Count

'Do something with array

oXMLFile.Save (XMLFileName)

End Sub