VBA——将Excel内容转换成多页PPT

Rem 本视频示例代码

Sub Excel转PPT()

  Dim arr

  Dim ar

  Dim pptApp As Object

  Dim prs As Object

  Dim sld As Object

  Dim i As Long

  Dim sp As Object

  Dim sp1 As Object

   

  Set pptApp = CreateObject("PowerPoint.Application")

  pptApp.Visible = True

  Set prs = pptApp.Presentations.Add

   

  arr = ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion.Value

   

  For Each ar In arr

    If ar <> "" Then

      Debug.Print ar

       

      '新建幻灯片

      Set sld = prs.slides.addslide(prs.slides.Count + 1, prs.SlideMaster.CustomLayouts(1))

       

      '删除自带的形状

      For i = sld.Shapes.Count To 1 Step -1

        Set sp = sld.Shapes(i)

        sp.Delete

      Next

       

      '添加一个形状（文本框）并写入内容

      Set sp1 = sld.Shapes.AddTextbox(1, 100, 200, 600, 300)

       

      With sp1.TextFrame

        With .TextRange

          .Text = ar

        End With

      End With

    End If

  Next

   

  'pptApp.Quit '如果文件尚未保存到本地，请不要执行这句

  Set pptApp = Nothing

  Set prs = Nothing

  Set sld = Nothing

  Set sp = Nothing

  Set sp1 = Nothing

End Sub