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

Question

I have PowerPoints that are automatically generated from software. The software puts the content (text) into Text Boxes instead of placeholders. I need to create and run a macro that will add all of the text to the Outline View (for Accessibility purposes).
I have a script that will move the text box content into the placeholder which by default shows up in the outline view. The only problem with this is that it is not retaining the styling (bulleted lists with subbullets are not working). The styling becomes especially problematic when I combine multiple Text Boxes from one slide into a single placeholder.
Any thoughts?
Here is my current script (the important stuff):
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
Here are some examples:
The First Image is what I start with:
This is what it looks like after running my script:
This is what I want it to look like (simply maintaining formatting):

Answer 1

Would resetting the slide help?
You could add the line:
CommandBars.ExecuteMso ("SlideReset")
Just before:
Next sld
That should set the formatting in the textbox to the way it is on the master.

Answer 2

The fix was to Paste Special into the the new placeholder without replacing all contents. Since I was iterating through the textboxes in reverse order, I simply copied each TextBox and then Pasted Special into the placeholder at position 0 (leaving all current content there).
I converted the code to C#, and this is the full solution:
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!");
}
}