這是學生問題, 我修正一些資訊與大家分享
Sub 試算表變簡報()
Dim rng1, rng2 As Range
Dim ppt, myppt, myslide, myobj As Object
Set rng1 = ActiveWorkbook.Sheets(1).Range("A2:F6")
Set rng2 = ThisWorkbook.ActiveSheet.Range("H2:M6")
On Error Resume Next
Set ppt = GetObject(class:="PowerPoint.Application")
Err.Clear
If ppt Is Nothing Then Set ppt= CreateObject(class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "無法啟動簡報"
Exit Sub
End If
On Error GoTo 0
Application.ScreenUpdating = False
Set myppt = ppt.Presentations.Add
Set myslide = myppt.Slides.Add(1, 12)
rng1.Copy
myslide.Shapes.PasteSpecial DataType:=2
Set myobj = myslide.Shapes(myslide.Shapes.Count)
myobj.Left = 150
myobj.Top = 20
myobj.Width = 400
rng2.Copy
myslide.Shapes.PasteSpecial DataType:=2
Set myobj = myslide.Shapes(myslide.Shapes.Count)
myobj.Left = 150
myobj.Top = 250
myobj.Width = 400
ppt.Visible = True
ppt.Activate
Application.CutCopyMode = False
End Sub