有没有办法“按原样”检索与 PowerPoint 演示文稿中的图片相对应的内部存储的 EMF 文件？

Posted 2023-03-29

【中文标题】有没有办法“按原样”检索与 PowerPoint 演示文稿中的图片相对应的内部存储的 EMF 文件？

【英文标题】：Is there a way to retrieve "as is" the internally stored EMF file corresponding to a picture in a PowerPoint presentation?

【发布时间】：2021-06-05 21:37:51

【问题描述】：

背景： 我是IguanaTex 的开发人员，这是一个 PowerPoint 插件，用于将 LaTeX 显示/方程式插入 Windows 和 Mac 上的 PowerPoint。 许多 Mac 用户使用另一个软件，LatexIt，将由 LaTeX 生成的 PDF 插入 PowerPoint（和其他应用程序）； PDF 以一种相当复杂的方式将 LaTeX 源存储为元数据，并且该元数据仍然可以在 PowerPoint 内部用于存储 PDF 的 EMF 文件中访问（可以通过解压缩 .pptx 文件获得）。它还保存在使用 Mac 上的“将图片另存为 PDF”创建的 PDF 中。 我想允许 Windows 上的 IguanaTex 用户检索该 LaTeX 信息，以便他们可以修改 Mac 上的 LatexIt 用户创建的幻灯片。

问题： 我想我可以使用“将图片另存为 .emf”提取与插入的 PDF 相对应的内部 EMF，并对其进行解析。 LatexIt 的开发人员好心准备了一个 Windows 可执行文件，该可执行文件可以从 EMF 文件（例如 PowerPoint 内部存储的文件）中检索该信息。 不幸的是，我意识到在 Windows 上使用“将图片另存为 .emf”从通过在 Mac 上插入 PDF 获得的图片中获取 EMF 文件并不会导致 PowerPoint 内部使用相同的 EMF 文件，并且 LatexIt 元数据丢失在过程。

我很悲观，但有人能找到解决办法吗？要么以某种方式访问​​内部 EMF 文件，要么使用其他程序保存为 EMF？

澄清情况：我在 Windows 上有一个 open .pptx 文件，其中可能包含数十张图片/形状/等，我知道该文件中的一个选定形状在内部是 EMF 图片;如何使用 VBA 提取该 EMF 文件？

【问题讨论】：

我有一个仅限 Windows 的宏可以执行此操作，但您的目标是 macOS。在 Mac 上，您必须使用 AppleScript 来访问 macOS 中 zip 实用程序的命令行版本（GUI 存档实用程序有问题，无法解压缩 Office 文件）。然后您可以解压缩文件并获取 EMF。很不幸，很笨拙。

我的目标实际上是 Windows，那太好了！在 Mac 上，我可以另存为 PDF。在 VBA 中，如果我使用 .export 保存为 emf，我会遇到与“另存为 emf”相同的问题（它们是一样的，对吗？）。你能分享那个宏吗？此外，我需要在演示文稿打开时执行此操作。是否要创建一个仅包含该图片的新演示文稿，保存它，然后重命名、解压缩并提取媒体文件？

Windows 可以原生解压文件；当我搜索“vba unzip”（不带引号）时，Google 的第一个答案指向 Ron DeBruin 的网站，这是一个有用代码的金矿，也是我运行过的“如何使其在 Mac 上运行”vba 信息的最佳来源穿过。还有一些商业代码库可以从 Zips 中提取文件。

感谢指点！我只是没有想到在演示文稿打开时通过解压缩来提取文件是可能的，但如果我猜对了，我的想法是创建一个包含该文件的新演示文稿。我会试试的。如果这就是他的宏所做的，我很想听听约翰的意见。

宏必须在关闭的文件上工作。如果文件在 PowerPoint 中打开，您可以使用 VBA 保存副本，然后在其上运行宏以提取 EMF。

【参考方案1】：

这是提取演示文稿内部存储中与所选图片形状相对应的文件的代码（msoPicture，此处为 EMF 类型，但可以是任何受支持的类型：JPG、PNG、GIF...）：

Option Explicit

Sub ExtractShapeImageFromZip() 
    ' This can be easily modified to take input arguments:
    ' ExtractShapeImageFromZip(vSh As Shape, Optional ImageType As String = "EMF")
    
    Dim Sel As Selection
    Set Sel = Application.ActiveWindow.Selection
    Dim vSh As Shape
    Set vSh = Sel.ShapeRange(1)
    
    Dim ImageType As String
    ImageType = "EMF" ' <- change the type here
    Dim ImageExt As String
    ImageExt = "." & LCase$(ImageType)
    Dim ImageFilter As String
    ImageFilter = "ppt\media\image1" & ImageExt
    
    Dim StartFolder As String
    StartFolder = ActivePresentation.Path

    Dim FilePrefix As String
    FilePrefix = StartFolder & "\ExtractFromZip_tmp"
        
    ' Variables for the Shell execution call
    Dim TimeOutTimeString As String
    TimeOutTimeString = "20" ' Wait N seconds for the processes to complete
    Dim TimeOutTime As Long
    TimeOutTime = Val(TimeOutTimeString) * 1000
    Dim debugMode As Boolean
    debugMode = False
    Dim RetVal As Long
    
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If vSh.Type = msoPicture Then
        ' Copy/Paste shape to new presentation
        Dim NewPres As Presentation
        Set NewPres = Presentations.Add(msoFalse)
        Dim NewSlide As Slide
        Set NewSlide = NewPres.Slides.Add(Index:=1, Layout:=ppLayoutBlank)
        Dim NewShape As Shape
        vSh.Copy
        NewPres.Slides(1).Shapes.Paste
        NewPres.SaveAs (FilePrefix & ".pptx")
        NewPres.Close
        Set NewPres = Nothing
        fs.CopyFile FilePrefix & ".pptx", FilePrefix & ".zip", True
        fs.DeleteFile FilePrefix & ".pptx"
        RetVal& = Execute("unzip -o " & FilePrefix & ".zip" & " " & ImageFilter _
                            & " -d " & FilePrefix, StartFolder, debugMode, TimeOutTime)
        If fs.FileExists(FilePrefix & ".zip") Then
            fs.DeleteFile FilePrefix & ".zip"
        End If
        If fs.FileExists(FilePrefix & "\" & ImageFilter) Then
            fs.CopyFile FilePrefix & "\" & ImageFilter, FilePrefix & ImageExt
            Dim picPath As String
            picPath = FilePrefix & ImageExt
            MsgBox "File of type " & ImageType & " successfully extracted to " & picPath
        End If
        If fs.FolderExists(FilePrefix) Then
            fs.DeleteFolder FilePrefix
        End If
    End If
    
End Sub

为了运行unzip，上面的代码使用了implemented in IguanaTex的Shell执行代码（去掉了ClipBoard调用，这里不需要，它来自另一个模块），很大程度上借鉴了Terry Kreft的"Shell and Wait" 。

通过将解压缩命令中使用的过滤器更改为"ppt\media\*.*"，可以轻松修改代码以提取任何媒体文件，但是从文件夹树下移动文件的清理工作变得有点乏味。