我目前正在为我们业务中的一个小组制定一个解决方案,允许他们使用PowerPoint 2013从高清分辨率的PowerPoint演示文稿创建幻灯片,并使用特定的文件名,通过不同的系统将其用作数字标牌这不支持PowerPoint文件。
我一直在寻找使用VBA根据需要导出文件的解决方案,但还没有达到标准。我自己并不是VBA程序员,并且尽力编译符合我需求的东西。
确切要求:
[Section Name] [Slide Title] [Unique Title Number].png
,如果幻灯片缺少标题,请将[Slide Title]
替换为[Placeholder Title]
,例如(不带括号):[KS4 All Temp] [20160630 20160731 Casual Dress] [1].png
。
这是我到目前为止的代码:
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
代码当前生成文件,但是每个幻灯片都复制了每个部分名称,而不仅仅是这些部分中的幻灯片。
答案 0 :(得分: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