VBA 从 PowerPoint 中导出图像，并将部分和标题作为文件名

Question

我目前正在为我们业务中的一个团队开发一个解决方案，该解决方案将允许他们使用 PowerPoint 2013 从高清分辨率的 PowerPoint 演示文稿创建幻灯片，并使用特定的文件名，这些文件名将通过不同的系统用作数字标牌不支持 PowerPoint 文件。

我一直在寻找一种使用 VBA 来根据需要导出文件的解决方案，但还没有完全成功。我自己不是 VBA 程序员，并且已尽最大努力编译出接近我需要的东西。

确切要求：

请求用户输入要导出到的目录
以 1920 x 1080 分辨率将幻灯片导出为 PNG 格式
仅导出文件尚不存在的幻灯片
文件名格式为 [Section Name] [Slide Title] [Unique Title Number].png，如果幻灯片缺少标题，请将 [Slide Title] 替换为 [Placeholder Title]，示例（无括号）：[KS4 All Temp] [20160630 20160731 Casual Dress] [1].png。
- 每张幻灯片的唯一标题编号应从 1 开始，除非生成多张同名的幻灯片，然后该编号应针对该文件名每张幻灯片递增

这是我目前的代码：

Option Explicit
Const ImageBaseName As String = "Slide_"
Const ImageWidth As Long = 1920
Const ImageHeight As Long = 1080
Const ImageType As String = "PNG"

Function fileExists(s_directory As String, s_fileName As String) As Boolean

    Dim obj_fso As Object

    Set obj_fso = CreateObject("Scripting.FileSystemObject")
    fileExists = obj_fso.fileExists(s_directory & "\" & s_fileName)

End Function

Sub ExportSlides()

    Dim oSl As Slide
    Dim Path As String
    Dim File As String
    Dim i As Long

    If ActivePresentation.Path = "" Then
        MsgBox "Please save the presentation then try again"
        Exit Sub
    End If

    Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Select Path"

    Path = GetSetting("FPPT", "Export", "Default Path")

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Select destination folder"
        If .Show = -1 And .SelectedItems.Count = 1 Then
            Path = .SelectedItems(1)
        Else: Exit Sub
        End If
    End With

    With ActivePresentation.SectionProperties
        For i = 1 To .Count
            For Each oSl In ActivePresentation.Slides
                If Not oSl.Shapes.HasTitle Then
                    File = .Name(i) & ImageBaseName & Format(oSl.SlideIndex, "0000") & "." & ImageType
                    Else: File = .Name(i) & oSl.Shapes.Title.TextFrame.TextRange.Text & Format(oSl.SlideIndex, "0000") & "." & ImageType
                End If
                If Not fileExists(Path, File) Then
                    oSl.Export Path & "\" & File, ImageType, ImageWidth, ImageHeight
                End If
            Next
        Next
    End With
End Sub

代码当前生成文件，但复制每张幻灯片的每个部分名称，而不仅仅是这些部分中的幻灯片。

Answer 1

顺序编号的一种方法：

Dim dict As Object, sName As String
Set dict = CreateObject("scripting.dictionary")


With ActivePresentation.SectionProperties
    For i = 1 To .Count
        For Each oSl In ActivePresentation.Slides

            If Not oSl.Shapes.HasTitle Then
                sName = .Name(i) & ImageBaseName
            Else
                sName = .Name(i) & oSl.Shapes.Title.TextFrame.TextRange.Text
            End If

            dict(sName) = dict(sName) + 1
            File = sName & Format(dict(sName), "0000") & "." & ImageType

            If Not fileExists(Path, File) Then
                oSl.Export Path & "\" & File, ImageType, ImageWidth, ImageHeight
            End If
        Next
    Next
End With

VBA 从 PowerPoint 中导出图像，并将部分和标题作为文件名

VBA to export images from PowerPoint with Section and Title as filename

powerpoint

vba

powerpoint-2013