2016-06-21 10 views
2

ソフトウェアから自動的に生成されるPowerPointがあります。ソフトウェアは、プレースホルダの代わりにテキストボックスにコンテンツ(テキスト)を配置します。アウトラインビューにすべてのテキストを追加するマクロを作成して実行する必要があります(アクセシビリティの目的で)。VBA - PowerPointマクロ - アウトラインビューにテキストボックスコンテンツを追加する

私は、テキストボックスの内容をデフォルトでアウトラインビューに表示されるプレースホルダに移動するスクリプトを用意しています。この問題の唯一の問題は、スタイリングを保持していないことです(小括弧付きの箇条書きリストは機能しません)。 1つのスライドの複数のテキストボックスを1つのプレースホルダに結合すると、スタイリングが特に問題になります。

どのような考えですか?ここで

は私の現在のスクリプト(重要なもの)である:ここでは

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 

は、いくつかの例は以下のとおりです。 まず画像は私が始めるものです: enter image description here

これは、それが後に次のようになります私のスクリプトを実行しています: enter image description here

これは私が(単純に書式を維持しているように)見せたいものです: enter image description here

+0

うーん...私はあなたの問題を再現することはできません。プレゼンテーションは特定のソフトウェアによって作成されるため、非常に具体的だと思います。私はその特定のTextBoxと少なくとも1つのスライドを含むプレゼンテーションを共有することをお勧めします。乾杯、Maciej。 –

+0

説明のためにスクリーンショットをいくつか追加しました。おかげで – jpsnow72

答えて

0

修正内容は、すべての内容を置き換えずに新しいプレースホルダにペーストすることでした。テキストボックスを逆順に繰り返していたので、各TextBoxをコピーしてから貼り付けた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!"); 
     } 
    } 
0

スライドのヘルプがリセットされますか?

あなたが行追加することができます。直前に

CommandBars.ExecuteMso( "SlideReset")

を:に書式を設定する必要があります

次のSLD

テキストボックスをマスター上に表示します。

+0

ジル、答えをありがとう。私はこれを試みたが、うまくいかなかった。 – jpsnow72

関連する問題