把excel中的内容搬迁到PPT中的VBA编程

这段程序放在excel的vba中，直接执行就可以了，是选定了当前sheet的A列，然后把这一列内容拷贝到ppt中，每一个cell值做ppt的一页中的一个标题

Sub test()

    
    Dim ptApp As Object
    Set ptApp = CreateObject("PowerPoint.Application")
    Dim ptPre As Object
    Set ptPre = ptApp.Presentations.Add
    Dim ptSld As Object
    Dim ptShape As Object
    ptApp.Visible = msoTrue
    
    ActiveSheet.Names.Add Name:="NewWord", RefersTo:="=OFFSET($A$1,0,0,COUNTA($A:$A))"
    Set R = ActiveSheet.Names("NewWord").RefersToRange
    dd = R.Count - 1
    
    For rr = 2 To dd + 1
        Set ptSld = ptPre.Slides.Add(Index:=ptPre.Slides.Count + 1, Layout:=ppLayoutBlank)
        Set ptShape = ptSld.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
              Left:=10, Top:=17, Width:=700, Height:=50)
        With ptShape.TextFrame
                .TextRange.Text = R(rr)
                .TextRange.Font.Name = "楷体_GB2312"
                .TextRange.Font.Size = 30
                .TextRange.Font.Color.RGB = RGB(Red:=0, Green:=0, Blue:=255)
                .TextRange.Font.Bold = True
        End With
        
        Set ptShape = ptSld.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
              Left:=10, Top:=80, Width:=700, Height:=450)
              
        With ptShape.TextFrame
                .TextRange.Text = "This is for test!"
                .TextRange.Font.Name = "楷体_GB2312"
                .TextRange.Font.Size = 25
        End With
        
        ptSld.Shapes(2).TextFrame.TextRange.Characters.Font.Color = vbBlack
    Next rr
End Sub