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

我有从软件自动生成的PowerPoint。该软件将内容（文本）放入文本框而不是占位符。我需要创建并运行一个将所有文本添加到大纲视图的宏（用于辅助功能）。VBA - 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

下面是一些例子：第一个图像是我开始：

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

这就是我想要它看起来像（简单地保持格式）：

来源

2016-06-21 jpsnow72

嗯...我不能重现您的问题。我认为这是非常具体的，因为演示文稿是由特定软件创建的。我建议分享一个演示文稿，其中至少包含一个带有特定文本框的幻灯片。干杯，Maciej。 –

我添加了一些屏幕截图以进行说明。谢谢 – jpsnow72

修复方法是将特殊粘贴到新的占位符中而不替换所有内容。由于我以相反顺序遍历文本框，因此我只复制每个TextBox，然后将Pasted Special复制到位置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!"); 
     } 
    }

来源

2016-07-06 11:51:03 jpsnow72

重置幻灯片的帮助？

你可以添加一行：

CommandBars.ExecuteMso（ “SlideReset”）

就在：

下一页SLD

这应该设置格式的文本框的方式，它是在主人。

来源

2016-07-05 13:33:30 Jill

吉尔，谢谢你的答案。我试过了，但没有奏效。 – jpsnow72

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

回答

相关问题