使用 VBA 一次压缩（以编程方式）PowerPoint 的所有图片

Question

我有一大堆自动生成的 PowerPoint 演示文稿，其中包含大量图片。我知道PowerPoint有一个“压缩图片”功能来降低分辨率。但由于我有很多 PowerPoint 演示文稿，我正在寻找一个 VBA 宏，它可以以相同的分辨率对宏当前演示文稿中的所有图片进行压缩。

换句话说，我正在寻找一个 VBA 宏，它可以自动“压缩图片”，并且未选中“仅应用于此图片”框。

在下面的帖子中，它一张一张地遍历所有图片，但这不是我想要的，因为我想以相同的分辨率压缩所有图片而不弹出框选择。

我如何（以编程方式）逐步浏览所有图片并让用户选择压缩？

我对 VBA 真的很差，无法调整这篇文章中的宏来生成我想要的东西。 另外，我不知道在 VBA 中设置“HD”、“Print”或“Email”分辨率的字母是什么。是吗 ？ :

SendKeys "%h", True
SendKeys "%p", True
SendKeys "%e", True

谢谢你

编辑

经过一些工作和研究，我想出了一个脚本，但我没有时间快速上传它。我的歉意。 因此，当我在 PowerPoint 中手动运行宏脚本时，它运行良好。 但是，当我尝试从Python作为自动命令行启动时，有时它运行良好，有时它会自动运行宏但不会压缩所有图片。另外，每次我运行宏时，它都会停用“Num lock”键盘按钮（可能是因为 DoEvents ？）。我仍然不知道为什么这两个问题。

Sub Compress_Picture_print_quality()
   Dim shp As Shape
   Dim sld As Slide
   Dim get_out As Boolean
   Dim ppt As Presentation
   
   get_out = False
   For Each sld In ActivePresentation.Slides
      sld.Select
      For Each shp In sld.Shapes
         If shp.Type = msoPicture Then
            shp.Select
            Application.CommandBars.ExecuteMso "PicturesCompress"
            SendKeys "%(p)",True 'or i.g. w for web, or e for email compression
            SendKeys "%(a)",False
            SendKeys "(ENTER)",True
            DoEvents ' I think this desactivates the Num Lock pad button of my keyboard. I have no clue why so
            get_out = True
            Exit For
         End If
      Next shp
      If get_out Then
         Exit For
      End If
   Next sld

   'Now I want to save the presentation and close it without closing other open PowerPoint files

   With Application.ActivePresentation
      If Not .Saved And .Path <> "" Then .Save
   End With

   If PowerPoint.Application.Version >= 9 Then
      PowerPoint.Application.Visible = msoTrue
   End If
   PowerPoint.ActivePresentation.Window(1).Close
End Sub

上面的 VBA 宏在 PowerPoint 中手动运行时工作正常（除了 Num Lock 按钮的停用，我仍然不明白）。

但是当我使用子进程命令运行 VBA 宏时（见下文），有时会运行压缩，有时不会。真的很奇怪的行为我仍然不明白

import os
import subprocess    
os.chdir(r"C:\my_dir")
path_to_ppt_exe = r"C:\POWERPNT.EXE"
command = path_to_ppt_exe + ' /M "presentation.ppt" Compress_Picture_print_quality'
subprocess.run(command)

Answer 1

每行包含一个带有下划线的字母，代表带有 Alt 键的键盘快捷键。例如：

使用默认...——这意味着快捷方式是