VBA从PowerPoint导出图像，其中Section和Title作为文件名

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

我一直在寻找使用VBA根据需要导出文件的解决方案，但还没有达到标准 . 我自己不是VBA程序员，并且尽我所能来编译一些接近我需要的东西 .

确切要求：

• 请求用户输入要导出的目录

• 以1920 x 1080分辨率将幻灯片导出为PNG格式

• 仅导出文件尚不存在的幻灯片

• 文件名格式为 [Section Name] [Slide Title] [Unique Title Number].png ，如果幻灯片缺少 Headers ，则将 [Slide Title] 替换为 [Placeholder Title] ，示例（不带括号）： [KS4 All Temp] [20160630 20160731 Casual Dress] [1].png .

• 每个幻灯片的唯一 Headers 编号应从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

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