pptVBA_多段文字拆为多个图形

Sub SplitTextFrame()
　　 '多段落文本框拆为多文本框一段落，加上（#）编号
    Dim pre As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim shp2 As Shape
    
    Set pre = ActivePresentation
    Set sld = ActiveWindow.View.Slide
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    s = shp.TextFrame.TextRange.Text
    
    s = Replace(s, vbCr, vbCrLf)
    
    If InStr(s, vbCrLf) > 0 Then
        arr = Split(s, vbCrLf)
        n = 0
        e0 = arr(0)
        For Each e In arr
            n = n + 1
            If n > 1 Then
                shp.Copy
                sld.Shapes.Paste
                Set shp2 = sld.Shapes(sld.Shapes.Count)
                shp2.Left = shp.Left
                shp2.Top = shp.Top + (shp.Height * 3 / 2) * (n - 1)
                shp2.TextFrame.TextRange.Text = "(" & n & ")" & e
                Else
                   shp.TextFrame.TextRange.Text = "(1)" & e
                End If
        Next e
    End If
   Set sld = Nothing
   Set shp = Nothing
   Set shp2 = Nothing
End Sub