How to get delay between letters in PowerPoint application? - vba

Question

I want to export animation as mp4 in PowerPoint and get the timeline of all animation.
How do I get the delay between letters if the effect has EffectInformation.TextUnitEffect as msoAnimTextUnitEffectByCharacter?
Most documentation for PowerPoint I have read, but no message for "%delay between letters".
effectinformation documentation has no message as delay between letters in (https://learn.microsoft.com/en-us/office/vba/api/powerpoint.effectinformation.textuniteffect)
CONST ppLayoutBlank = 12 ''ppt new black slide
CONST ppSaveAsMP4 = 39 ''ppSaveFormat for mp4
CONST ForAppending = 8 ''log file write for appending
const ppViewSlideMaster = 2 ''viewtype
const ppViewHandoutMaster = 4
const ppViewTitleMaster = 8
const ppViewMasterThumbnails = 12
const msoAnimTextUnitEffectByCharacter = 1
Dim filePath
dim logFilePath
dim logFile
dim fullPath
logFilePath = ".\convert.log" '''''''logfile
filePath = SelectFile()
if len(filePath)<1 then
wscript.quit
end if
MsgBox filePath + ";"
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
''create log file
if ObjFSO.fileExists(logFilePath) then
set logFile = ObjFSO.OpenTextFile(logFilePath, ForAppending)
else
set logFile = ObjFSO.CreateTextFile(logFilePath)
end if
''do job
pptAnimate(filePath)
''quit or not
''objPPT.Quit()
Function SelectFile()
dim selectPath,selectPathLen
Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
selectPath = oExec.StdOut.ReadAll
selectPathLen = len(selectPath)
SelectFile = left(selectPath, selectPathLen-2)'''''remove \r\n, vbcr、vblf
End Function
Sub pptAnimate(pptPath)
if not (regMatch(pptPath, "\.(ppt|pptx)$")) then
exit sub
end if
Set pptInput = objPPT.Presentations.Open(pptPath)
logFile.WriteLine("slide count:" + cstr(pptInput.Slides.Count))
For i = 1 To pptInput.Slides.Count
if pptInput.Slides(i).TimeLine.MainSequence.Count > 0 then
Dim tmpPath
tmpPath = "F:\\word\\" + cstr(i) + ".pptx"
ObjFSO.CreateTextFile(tmpPath)
Set pptOutput = objPPT.Presentations.Open(tmpPath)
Set newSlide = pptOutput.Slides.Add(1, ppLayoutBlank)
pptOutput.PageSetup.slideWidth = pptInput.PageSetup.slideWidth
pptOutput.pageSetup.slideHeight = pptInput.pagesetup.slideheight
pptInput.Slides(i).Copy
pptOutput.Slides.Paste (pptOutput.Slides.Count)
logFile.WriteLine("page:" + cstr(i) + " sequence count:" + cstr(pptInput.Slides(i).TimeLine.MainSequence.Count))
For Each effect in pptInput.Slides(i).TimeLine.MainSequence
logFile.WriteLine("{delay time:" + cstr(effect.Timing.TriggerDelayTime) _
+ ", duration time:" + cstr(effect.Timing.Duration) _
+ ", Decelerate :" + cstr(effect.Timing.Decelerate) _
+ ", triggerType:" + getTriggerType(effect.Timing.TriggerType) _
+ ", Accelerate:" + cstr(effect.Timing.Accelerate) _
+ ", Decelerate:" + cstr(effect.Timing.Decelerate) _
+ ", Speed:" + cstr(effect.Timing.Speed) _
+ "}")
if msoAnimTextUnitEffectByCharacter = effect.EffectInformation.TextUnitEffect then
''I don't know how to get dealy between letters, have no way to set the effect to by graph
''effect.EffectInformation.TextUnitEffect = 0 '''readonly
end if
For Each behaviour in effect.Behaviors
logFile.WriteLine("behaviour {delay time :" + cstr(behaviour.Timing.TriggerDelayTime) + ", duration time :" + cstr(behaviour.Timing.Duration) + "}")
Next
Next
m = pptOutput.Slides.Count
pptOutput.Slides(m).Delete
''fullPath = "F:\\word\\"+cstr(i)+".mp4"
''pptOutput.SaveAs fullPath,ppSaveAsMP4
'''wait until the mp4 file exist,
'''msgbox fullPath
pptOutput.Save
pptOutput.Close
end if
Next
pptInput.Close
End Sub
Function regMatch(strng,Pattern)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = Pattern
regEx.IgnoreCase = True
regEx.Global = True
regMatch = regEx.test(strng)
Set regEx = Nothing
End Function
'https://learn.microsoft.com/zh-cn/office/vba/api/powerpoint.msoanimtriggertype
Function getTriggerType(triggerType)
getTriggerType = ""
Select Case triggerType
Case 3
getTriggerType = "msoAnimTriggerAfterPrevious"
Case -1
getTriggerType = "msoAnimTriggerMixed"
Case 0
getTriggerType = "msoAnimTriggerNone"
Case 1
getTriggerType = "msoAnimTriggerOnPageClick"
Case 4
getTriggerType = "msoAnimTriggerOnShapeClick"
Case 2
getTriggerType = "msoAnimTriggerWithPrevious"
End Select
End Function
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " "& h &":" & mi &":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyymmdd
Format_Time = y & m & d
End Select
End Function

Answer 1

The value for "seconds delay between letters" is not directly exposed in the object model.
While it's still possible to extract the value in VBA, the process is quite complicated. At a high level, you need to:
Use Presentation.SaveCopyAs to save a copy in "pptx" format, but with the "zip" extension, e.g. temp.zip
Use late binding to create a Shell.Application object
Use the shell object to copy temp.zip\ppt\slides\slideN.xml to a folder (N = the slide number)
Read the XML file and inspect the animation element. The exact value you are looking for ("seconds delay between letters") should be in an element like <p:tmAbs val="50"/>
The timing is in ms. So the 50 in the example would be 0.05s in the PowerPoint UI.
Because there could be many animations on the same slide, you may need to find the right animation sequence in the XML. It's definitely not an easy process, and particularly challenging to do in VBA. If possible, I would recommend that you use build a small utility exe file using C# or VB.NET to parse the XML and read the necessary information directly from the PPTX file and invoke the program from VBA. We did something similar for a different purpose, and it worked fairly well.
The first three steps can be used for extracting almost everything not available through the Object Model. For Word, you don't have to do that because it exposes a property WordOpenXML. Unfortunately, such property does not exist in Excel or PowerPoint.