☰

PowerPoint 2013(6): установите длительность слайдов в соответствии с длительностью закадрового текста

tag-icon • tag-icon vba microsoft-powerpoint gui timing
PowerPoint 2013(6): установите длительность слайдов в соответствии с длительностью закадрового текста

Я случайно побежалЧеткое время показа на всех слайдахcommand и потерял все тайминги слайдов. Однако каждый слайд моей презентации имеет закадровый текст. Есть ли способ GUI/VBA установить тайминги слайдов в соответствии с длительностью закадрового текста для всех слайдов?

Спасибо.

решение1

Я разработал временное решение:

  1. Выберите аудиоклип на слайде.
  2. ПодАудио инструменты, наВоспроизведениевкладка, щелкнитеОбрезать аудио. Обратите внимание на общую продолжительность воспроизведения, указанную в правом верхнем углу.
  3. Настроить вручнуюРегулироватьслайд-тайминг наПереходывкладка, вСрокигруппа, подПродвинутый слайд, вПослеполе ввода.

Рабочий процесс работает, но он выполняется вручную и, следовательно, трудоемок.

Знаете ли вы способ узнать общую длительность воспроизведения звука через VBA?

решение2

Вот небольшой код VBA, который выдаст вам общую длительность звуков в вашей презентации (и попутно вернет звук для каждого... вы можете изменить код, если вам нужно разделить его):

Sub SumSoundLengths()

    Dim oSh As Shape
    Dim oSl As Slide
    Dim sngLengthOfSound As Single
    Dim sngSoundDuration As Single
    
    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
        If oSh.Type = msoMedia Then
            If oSh.MediaType = ppMediaTypeSound Then
                With oSh
                    sngLengthOfSound = .MediaFormat.Length
                    sngSoundDuration = sngSoundDuration + sngLengthOfSound
                End With
            End If
        End If
        Next
    Next
    
    MsgBox "Sounds total to: " & CStr(sngSoundDuration)
    
End Sub

решение3

Вот скрипт, который я придумал на основе ответа Стива здесь. Я столкнулся с проблемой, когда переменная перехода слайдов по какой-то причине превысила, казалось бы, произвольный предел 86,4. Если вы измените это число, и это не приведет к ошибке, смело удаляйте все вместе.

Sub SetTransitionTimings()

      Dim shapeObj As Shape
      Dim slideObj As Slide
      Dim sngLengthOfSound As Single
      Dim slideDuration As Single

      For Each slideObj In ActivePresentation.Slides

              slideDuration = 0

              For Each shapeObj In slideObj.Shapes

                              If shapeObj.Type = msoMedia Then
                                             If shapeObj.MediaType = ppMediaTypeSound Then
                                                            With shapeObj
                                                                    .AnimationSettings.PlaySettings.PlayOnEntry = msoTrue
                                                                    sngLengthOfSound = .MediaFormat.Length / 1000
                                                                    slideDuration = slideDuration + sngLengthOfSound
                                                            End With
                                             End If
                              End If

              Next

              If slideDuration = 0 Then
                              slideDuration = 5
              End If

              If slideDuration < 86.4 Then
                            With slideObj.SlideShowTransition
                                    .AdvanceOnTime = msoTrue
                                    .Duration = 1
                                    .AdvanceTime = slideDuration
                            End With
              Else
                            Debug.Print "Slide " & slideObj.SlideNumber & ": " & slideDuration
              End If

      Next

      MsgBox "Transition timings set."

End Sub

решение4

Просто хотел отметить, что в последней версии PowerPoint, похоже, есть ошибка, которая вызывает хаос с таймингами. Видимо, в опции ленты ПЕРЕХОДЫ опция "Перейти к слайду через XXX секунд" автоматически отмечена по умолчанию. Если вы редактируете какие-либо переходы и НЕ снимаете этот флажок, все ваши тайминги будут стерты и заменены числом, показанным в опции ленты.

Я потратил дни, пытаясь исправить презентации, в которых были стерты тайминги закадрового текста, доходя до того, что перезаписывал закадровый текст (никакой радости), а затем прибегая к захвату экрана, запуская всю презентацию вручную, а затем конвертируя в видео. Решение Джона Джи выше исправило это, всего за 25 секунд.

Спасибо, Джон!

Связанный контент