PowerPoint宏问题：.pptm转.pptx路径错误及Mac权限弹窗解决

一、修复保存路径错误问题 #

你的代码中保存路径错误的核心原因是直接将文件名拼接在文件夹路径后，导致系统将修改后的字符串识别为上一级目录下的文件。以下是修正后的代码及关键说明：

修改后的完整代码 #

Sub EditPowerPointLinks()

Dim oldFilePath As String
Dim newFilePath As String
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape
Dim idnName As String
Dim saveName As String
Dim folderName As String
Dim originalFile As String ' 存储原.pptm文件完整路径

folderName = ActivePresentation.Path
originalFile = ActivePresentation.FullName ' 获取原文件路径，用于后续删除

longName = Right(folderName, Len(folderName) - 39)
idnName = Left(longName, Len(longName) - 5)

ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = idnName
ActivePresentation.Slides(2).Shapes(1).TextFrame.TextRange.Text = idnName & " | 2023"

oldFilePath = "File Path"
newFilePath = ActivePresentation.Path & "/Images/"

Set pptPresentation = ActivePresentation

For Each pptSlide In pptPresentation.Slides
    For Each pptShape In pptSlide.Shapes
        If pptShape.Type = msoLinkedPicture Or pptShape.Type _
        = msoLinkedOLEObject Or pptShape.Type = msoLinkedChart Then
            pptShape.LinkFormat.SourceFullName = Replace(LCase _
            (pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)
        End If
    Next
Next

pptPresentation.UpdateLinks

' 修正保存路径：文件夹路径 + "/" + 目标文件名
With ActivePresentation
    .SaveAs _
        FileName:=folderName & "/" & idnName & "_File Name.pptx", _
        FileFormat:=ppSaveAsOpenXMLPresentation
End With

' 关闭原文件并删除.pptm
pptPresentation.Close
Kill originalFile

End Sub

关键修改点 #

• 新增originalFile变量存储原.pptm的完整路径，用于后续删除操作
• 保存路径改为folderName & "/" & idnName & "_File Name.pptx"，确保文件保存到当前目录下
• 添加pptPresentation.Close和Kill originalFile，实现关闭并删除原文件的需求

二、Mac系统图片链接授权问题解决方案 #

针对Mac Office的沙箱权限限制，可尝试以下方案：

• 方案1：授予PowerPoint完全磁盘访问权限

  1. 打开系统偏好设置 → 安全性与隐私 → 隐私标签
  2. 点击左下角锁图标解锁，找到“完全磁盘访问权限”
  3. 点击加号，添加PowerPoint应用到列表
  4. 重启PowerPoint后生效

• 方案2：统一存放文件至“文档”文件夹
  Mac Office默认对“文档”文件夹有访问权限，将PPT模板、图片文件夹都放在该目录下，可避免重复授权

• 方案3：通过对话框获取路径授权
  在代码开头添加文件夹选择逻辑，通过系统对话框让用户选择目标文件夹，VBA会自动获得该路径的访问权限：

  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  If fd.Show = -1 Then
      folderName = fd.SelectedItems(1)
  Else
      Exit Sub ' 用户取消选择则退出宏
  End If
  

  替换原代码中folderName = ActivePresentation.Path这一行即可

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