VBA: append text below current text

Question

I have a slide with text in a shape that I'd like to append text to the bottom of that text. This macro seems to almost get me there, but the problem comes in with the numbers before each paragraph. Those numbers are Superscripted and bold. With this macro, I get the text inserted below, but everything is Superscripted with bold text.

Sub nnnn() 

    Dim SlideIndex As Long: SlideIndex = ActiveWindow.View.Slide.SlideIndex 

    Dim myText As String: myText = Application.ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame.TextRange.Text 

    Application.ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame.TextRange.Text = myText & vbCrLf & "Some Text" 

    Dim j As Long: j = Application.ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame2.TextRange.Paragraphs.Count 

    With ActivePresentation.Slides(SlideIndex).Shapes(2) 

        With .TextFrame.TextRange.Paragraphs(j).ParagraphFormat.Bullet 

            .Visible = True 

            .RelativeSize = 1 

            .Character = 8226 

            .Font.Name = "Calibri" 

        End With 

    End With 

    ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame2.TextRange.ParagraphFormat.LeftIndent = 72 * 0.25 

    ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame2.TextRange.ParagraphFormat.FirstLineIndent = -72 * 0.25 

End Sub

Answer 1

Does

Application.ActivePresentation.Slides(SlideIndex).Shapes(2).TextFrame.TextRange.InsertAfter vbCrLf & "Some Text"

work for you?

Answer 2

Yes, this work great. Thank you for time!