要让你的代码自动针对当前选中/激活的幻灯片删除表格，只需要替换掉原来硬编码指定幻灯片编号的部分，改用PowerPoint内置的活动幻灯片引用即可。

关键修改点 #

原来的代码里这行是固定指向幻灯片3：

Set sl = pr.Slides(3)

把它替换成指向当前活动幻灯片的代码，还可以加个小判断避免无选中幻灯片时报错：

' 先确保当前视图有可操作的活动幻灯片
If ppt.ActiveWindow.View.Type = ppViewNormal Or ppt.ActiveWindow.View.Type = ppViewSlide Then
    Set sl = ppt.ActiveWindow.View.Slide

完整修改后的代码 #

Sub CopytoPPT()
    Dim rng As Excel.Range
    Dim sl As PowerPoint.Slide, sl_cnt As Long, pr As Object, pr_name As String, ppt As Object
    Dim i As Long, j As Long
    
    Set ppt = GetObject(, "PowerPoint.Application")
    Set pr = ppt.Presentations(1)
    
    ' 关键修改：获取当前活动幻灯片，而非固定编号的幻灯片
    ' 增加视图判断，避免在无选中幻灯片的场景下报错
    If ppt.ActiveWindow.View.Type = ppViewNormal Or ppt.ActiveWindow.View.Type = ppViewSlide Then
        Set sl = ppt.ActiveWindow.View.Slide
        
        ' 从后往前遍历形状（避免删除形状后索引混乱）
        For i = sl.Shapes.Count To 1 Step -1
            If IsTable(sl.Shapes(i)) Then
                sl.Shapes(i).Delete
            End If
        Next i
    Else
        MsgBox "请先选中要操作的幻灯片！"
    End If
End Sub

Function IsTable(oSh As Variant) As Boolean
    If oSh.Type = msoPlaceholder Then
        If oSh.PlaceholderFormat.ContainedType = msoTable Then
            IsTable = True
        End If
    Else
        If oSh.HasTable Then
            IsTable = True
        End If
    End If
End Function

细节说明 #

1. ppt.ActiveWindow.View.Slide会直接指向当前PowerPoint窗口中正在查看或选中的幻灯片，不管它的编号是多少，完美实现你要的“任意活动幻灯片”需求。
2. 新增的视图类型判断，是为了防止在幻灯片浏览视图、备注页视图等没有单独活动幻灯片的场景下运行代码导致错误，同时给用户友好提示。
3. 原来从后往前遍历形状的逻辑保留得非常好——如果从前往后删除形状，会导致后续形状的索引发生变化，容易出现漏删或运行报错的问题。

内容的提问来源于stack exchange，提问作者jmw125