我帮你把这段代码补全并优化，完整实现从PPT提取图片再导入Excel的功能，代码里加了详细注释，直接就能用：

Sub ExtractImagesFromPres()
    Dim oSldSource As Slide
    Dim oShpSource As Shape
    Dim Ctr As Integer
    Dim ObjExcel As Object
    Dim wb As Object
    Dim ws As Object
    Dim savePath As String
    Dim imgFileName As String
    
    ' 设置图片保存的文件夹（可自行修改路径，注意末尾要加\）
    savePath = Environ("USERPROFILE") & "\Desktop\PPT_Images\"
    
    ' 自动创建目标文件夹（如果不存在的话）
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    
    ' 初始化图片计数器
    Ctr = 1
    
    ' 遍历PPT中所有幻灯片
    For Each oSldSource In ActivePresentation.Slides
        ' 遍历当前幻灯片内的所有形状
        For Each oShpSource In oSldSource.Shapes
            ' 筛选出图片类型的形状（包含嵌入图和链接图）
            If oShpSource.Type = msoPicture Or oShpSource.Type = msoLinkedPicture Then
                ' 设置图片文件名，用计数器区分不同图片
                imgFileName = "PPT_Image_" & Ctr & ".png"
                ' 将图片导出到目标文件夹，格式为PNG（可替换为ppShapeFormatJPG等）
                oShpSource.Export savePath & imgFileName, ppShapeFormatPNG
                Ctr = Ctr + 1
            End If
        Next oShpSource
    Next oSldSource
    
    ' 创建Excel应用实例
    Set ObjExcel = CreateObject("Excel.Application")
    ' 让Excel窗口可见（不需要显示可改成False）
    ObjExcel.Visible = True
    ' 新建一个Excel工作簿
    Set wb = ObjExcel.Workbooks.Add
    ' 选择第一个工作表作为图片导入目标
    Set ws = wb.Worksheets(1)
    
    ' 重置计数器，准备导入图片
    Ctr = 1
    ' 遍历导出的图片，逐个插入到Excel中
    Do While Dir(savePath & "PPT_Image_" & Ctr & ".png") <> ""
        ' 将图片插入到对应单元格位置，大小与单元格匹配（可自行调整位置/尺寸）
        ws.Shapes.AddPicture _
            Filename:=savePath & "PPT_Image_" & Ctr & ".png", _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, _
            Left:=ws.Cells(Ctr, 1).Left, _
            Top:=ws.Cells(Ctr, 1).Top, _
            Width:=ws.Cells(Ctr, 1).Width, _
            Height:=ws.Cells(Ctr, 1).Height
        Ctr = Ctr + 1
    Loop
    
    ' 手动释放对象，避免内存泄漏
    Set ws = Nothing
    Set wb = Nothing
    Set ObjExcel = Nothing
    Set oShpSource = Nothing
    Set oSldSource = Nothing
    
    MsgBox "图片提取并导入Excel完成！共处理" & Ctr - 1 & "张图片。"
End Sub

关键功能说明： #

• 图片导出环节：自动创建保存文件夹，遍历PPT所有元素筛选图片，导出为指定格式；
• Excel导入环节：启动Excel并新建工作簿，将导出的图片逐个插入到工作表，位置与单元格绑定方便布局调整；
• 内存优化：脚本末尾手动释放所有对象，避免VBA残留内存占用问题。

使用注意：运行前确保PPT处于打开状态，且已启用宏功能；可根据需求修改图片保存路径、导出格式或Excel中图片的位置尺寸。

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