VBA

Question

我有软件自动生成的 PowerPoint。该软件将内容（文本）放入文本框而不是占位符。我需要创建运行一个宏，将所有文本添加到大纲视图（出于辅助功能目的）。

我有一个脚本可以将文本框内容移动到占位符中，该占位符默认显示在大纲视图中。唯一的问题是它没有保留样式（带有子项目符号的项目符号列表不起作用）。当我将一张幻灯片中的多个文本框组合到一个占位符中时，样式会变得特别成问题。

有什么想法吗？

这是我当前的脚本（重要的东西）：

For Each sld In ActivePresentation.Slides
 With ActivePresentation
 sld.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(2)

 Set hypCollection = New hyperColl 'Set the collection of arrays - 1 for each shape

 Set shp = sld.Shapes(1)


For j = sld.Shapes.Count To 1 Step -1
     Set shp = sld.Shapes(j)
     bolCopy = False
     If j = 3 Then
         sld.Shapes.Placeholders.Item(1).TextFrame.TextRange = shp.TextFrame.TextRange.Characters
         sld.Shapes.Placeholders.Item(1).Visible = msoTrue
         shp.Delete

    ElseIf j > 3 And shp.Type = msoTextBox Then
      sld.Shapes.Placeholders.Item(2).TextFrame.TextRange.InsertBefore (shp.TextFrame.TextRange.TrimText) '.ParagraphFormat.Bullet.Type = shp.TextFrame.TextRange.ParagraphFormat.Bullet.Type
         If hypCollection.Exists(shp.Name) Then
              hypArray = hypCollection.GetArray(shp.Name)
              For i = LBound(hypArray) To UBound(hypArray)
                  Set hypToAdd = hypArray(i)
                 With sld.Shapes.Placeholders.Item(2).TextFrame.TextRange.Characters(hypToAdd.getchrStart, Len(hypToAdd.getHypText)).ActionSettings.Item(1)
                       .Action = ppActionHyperlink
                       .Hyperlink.Address = hypToAdd.getHypAddr
                 End With
              Next i
         End If

      shp.Delete
    End If
 Next j
 End With
 Next sld

这里有一些例子：第一张图片是我的开头：

这是运行执行我的脚本后的样子：

这就是我想要的样子（只是保持格式）：

Answer 1

重置幻灯片会有帮助吗？

您可以添加以下行：

CommandBars.ExecuteMso ("SlideReset")

之前：

下一个sld

这应该将文本框中的格式设置为母版中的格式。

Answer 2

解决方法是将特殊内容粘贴到新的占位符中，而不替换所有内容。由于我以相反的顺序遍历文本框，我只是复制了每个文本框，然后将特殊粘贴到位置 0 的占位符中（将所有当前内容留在那里）。

我将代码转换为 C#，这是完整的解决方案：

private void FixPPTDocument()
    {
        PPT.Application pptApp = new PPT.Application();
        PPT.Shape currShp;
        PPT.Shape shp2;



        if (File.Exists((string)fileLocation))
        {
            DateTime today = DateTime.Now;
            PPT.Presentation pptDoc = pptApp.Presentations.Open(fileLocation, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoTrue, Microsoft.Office.Core.MsoTriState.msoFalse);

            foreach (PPT.Slide slide in pptDoc.Slides)
            {
                slide.CustomLayout = pptDoc.Designs[1].SlideMaster.CustomLayouts[2];
                for (int jCurr = slide.Shapes.Count; jCurr >= 1; jCurr--)
                {
                    currShp = slide.Shapes[jCurr];
                    if (jCurr == 3)
                    {
                        slide.Shapes.Placeholders[1].TextFrame.TextRange.Text = currShp.TextFrame.TextRange.Text;
                        slide.Shapes.Placeholders[1].Visible = Microsoft.Office.Core.MsoTriState.msoTrue;
                        currShp.Delete();
                    }
                    else if (jCurr > 3 && currShp.Type == Microsoft.Office.Core.MsoShapeType.msoTextBox)
                    {
                        currShp.TextFrame.TextRange.Copy();
                        slide.Shapes.Placeholders[2].TextFrame.TextRange.Characters(0, 0).PasteSpecial();
                        currShp.Delete();
                    }
                }
            }
            pptDoc.SaveAs(fileNewLocation);
            pptDoc.Close();
            MessageBox.Show("File created!");
        }
    }

VBA - PowerPoint 宏 - 将文本框内容添加到大纲视图

VBA - PowerPoint Macro - Add Text Box content to Outline View

powerpoint