PowerPoint - установить время для каждого слайда и показать общее время презентации?

Question

Я знаю, что на вкладках перехода вы можете установить время для каждого слайда, но это когда вы используете его для автоматического перехода каждого слайда.

Я хотел бы, чтобы на каждом слайде было свойство времени, которое я могу установить. Затем, как докладчик, будет отображаться обратный отсчет, чтобы я мог видеть, перехожу ли я на какое-то конкретное слайд во время презентации.

Кроме того, это было бы замечательно, чтобы иметь возможность определить общее время презентации. Таким образом, на нижней панели инструментов будет элемент для Slide Time = 01:30, а другой для Slide Show Time = 05:45

Я боюсь, что это недоступно, и я думаю, что это было бы очень и очень полезно иметь.

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

Редактировать: я обнаружил, что могу отключить "Использовать время" в области "Показ слайдов" -> "Настройка", и это остановит автоматическое продвижение после каждого слайда, в то же время показывая время каждого слайда на странице слайд-шоу. Но это не дает мне таймер слайдов во время презентации или где-то еще, чтобы увидеть общее время презентации (и если у вас есть 30-45 слайдов, добавление времени для каждого слайда будет раздражать).

Answer 1

Вы можете скачать надстройку, которая даст вам то, что вы хотите. Видя, что у вас настроена первая часть, вы можете использовать эту надстройку, чтобы отобразить прошедшее время поверх текущего слайда.

На сайте, на который я ссылаюсь, есть инструкции по установке, но для удобства я приведу их здесь.

1. Загрузите исполняемый файл и дайте ему установить надстройку в папку по умолчанию. Я проверил исполняемый файл и установленные файлы надстроек на наличие вирусов, и я могу подтвердить, что они чистые.

2. После установки надстройки откройте PowerPoint и выполните следующие действия:

Файл -> Параметры -> Надстройки -> (Из раскрывающегося списка «Управление» внизу) выберите «Надстройки PowerPoint» и «Перейти».

3. В появившемся диалоге сделайте следующее:

Добавить новый -> выбрать TM PowerPoint Timer (ленточный интерфейс) -> ОК

Выше добавит вкладку TM на ленту PowerPoint. В окне конфигурации для таймера вы сможете установить таймер для отображения прошедшего времени. На первой вкладке также есть запись « Update Display », поэтому убедитесь, что вы установили ее на 1 секунду (по умолчанию 10 секунд).

Answer 2

Я надеюсь, что это не нарушит этикета, отвечая на мой собственный вопрос, так как я знаю, насколько модными могут быть следования протоколу. Но я нашел это, что может обеспечить общее время для показа слайдов. Он основан на времени, установленном для автоматического перехода слайда (Transitions-> Advance Slide-> After:). На ленте «Слайд-шоу» вы можете отключить "Использовать время", чтобы вы могли контролировать продвижение слайдов во время презентации.

Это не обеспечит обратный отсчет слайдов в представлении докладчика, но я полагаю, что я могу жить без этого и просто ввести ожидаемое время, которое я должен быть в верхней части моих заметок. Кажется, что надстройка обеспечивает обратный отсчет для представления докладчика, но я не смогу использовать его на своем месте, так что это не вариант.

Я основал этот макрос отсюда, FAQ по PowerPoint. Я немного его изменил, чтобы показывать время в формате «00:00» и общее время внизу вместо отдельного всплывающего окна. Чтобы использовать его, просто создайте перейти к View-> Macros и создайте новый макрос "Total Time". Скопируйте и вставьте код ниже:

Sub TotalTimes()

Dim oSld As Slide
Dim strMessage As String
Dim lngTotalTime As Long
Dim strSlideMin As String
Dim strSlidesec As String


' Use this to collect times for ALL slides:
For Each oSld In ActivePresentation.Slides
' Or comment it out and uncomment this to get just the selected slides:
' For Each oSld in ActiveWindow.Selection.SlideRange
    strSlideMin = Format(Int(oSld.SlideShowTransition.AdvanceTime / 60), "00")
    strSlidesec = Format(Int(oSld.SlideShowTransition.AdvanceTime Mod 60), "00")
    strMessage = strMessage _
        & CStr(oSld.SlideNumber) _
        & vbTab _
        & strSlideMin & ":" & strSlidesec _
        & vbCrLf
    lngTotalTime = lngTotalTime + oSld.SlideShowTransition.AdvanceTime
Next oSld

' Comment these out if you don't want to see them
strMessage = strMessage & vbCrLf & "Total" & vbTab & Format(Int(lngTotalTime / 60), "00") & ":" & Format(Int(lngTotalTime Mod 60), "00")
MsgBox strMessage
'MsgBox ("Total time: " & CStr(lngTotalTime))


End Sub

Оригинальный код также включает в себя раздел для записи в текстовый файл, который я вырезал, так как он не отвечал моим потребностям.

Я очень сильно удивлен, что MS не имеет этой информации в PowerPoint. Похоже, довольно интуитивно понятная информация, которую они будут включать по умолчанию

Answer 3

Я нашел решение на этой странице: ссылка. Автор создает таймер обратного отсчета в памяти и добавляет текст прогресса к последней фигуре, вставленной в каждый слайд.

Я немного изменил его, чтобы он не влиял на первый слайд и обновлял форму перед последним вставленным; Я всегда удаляю дату и номер слайда из нижнего колонтитула, а затем добавляю их по окончании презентации.

Чтобы установить количество минут для обратного отсчета , найдите TargetDateTime = DateAdd("n", 6, Now) и измените значение 6 .

Вот мой модифицированный код:

Option Explicit
'API Declarations
Declare PtrSafe Function SetTimer Lib "user32" _
                            (ByVal hwnd As LongLong, _
                             ByVal nIDEvent As LongLong, _
                             ByVal uElapse As LongLong, _
                             ByVal lpTimerFunc As LongLong) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" _
                            (ByVal hwnd As LongLong, _
                             ByVal nIDEvent As LongLong) As LongLong

' Public Variables
Public TimerID As LongLong
Public bTimerState As Boolean
Public TargetDateTime As Date


Sub TimerOnOff()

Dim maxshapes As Integer
Dim i As Integer

TargetDateTime = DateAdd("n", 6, Now)

For i = 2 To ActivePresentation.Slides.Count
    maxshapes = ActivePresentation.Slides(i).Shapes.Count
    ActivePresentation.Slides(i).Shapes(maxshapes - 1).TextFrame.TextRange.Text = ""
Next i

If bTimerState = False Then
    TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
    If TimerID = 0 Then
        MsgBox "Unable to create the timer", vbCritical + vbOKOnly, "Error"
        Exit Sub
    End If
    bTimerState = True
    SlideShowWindows(1).View.GotoSlide (SlideShowWindows(1).View.Slide.SlideIndex + 1)
Else
    TimerID = KillTimer(0, TimerID)
    If TimerID = 0 Then
        MsgBox "Unable to stop the timer", vbCritical + vbOKOnly, "Error"
    End If
    bTimerState = False
End If

End Sub

' The defined routine gets called every nnnn milliseconds.
Sub TimerProc(ByVal hwnd As LongLong, _
                    ByVal uMsg As LongLong, _
                    ByVal idEvent As LongLong, _
                    ByVal dwTime As LongLong)

Dim diff As Date
Dim out As String
Dim maxshapes As Integer
Dim i As Integer

Dim hours As String
Dim minutes As String
Dim seconds As String

Dim hoursTest As Boolean
Dim minutesTest As Boolean
Dim secondsTest As Boolean

diff = TargetDateTime - Now
out = ""

hoursTest = (Hour(diff) <> 0)
minutesTest = (Minute(diff) <> 0)
secondsTest = (Second(diff) <> 0)

hours = CStr(Hour(diff))
minutes = CStr(Minute(diff))
seconds = CStr(Second(diff))

If hoursTest Then
    If Hour(diff) < 10 Then
        out = out + "0"
    End If
    out = out + hours
End If

If minutesTest Or hoursTest Then
    If hoursTest Then
        out = out + ":"
    End If
    If Minute(diff) < 10 Then
        out = out + "0"
    End If
    out = out + minutes
End If

If secondsTest Or minutesTest Then
    If minutesTest Then
        out = out + ":"
    End If
    If Second(diff) < 10 Then
        out = out + "0"
    End If
    out = out + seconds
Else
    If minutesTest And hoursTest Then
        out = "END"
    End If
End If

On Error GoTo err:
For i = 2 To ActivePresentation.Slides.Count
    maxshapes = ActivePresentation.Slides(i).Shapes.Count
    ActivePresentation.Slides(i).Shapes(maxshapes - 1).TextFrame.TextRange.Text = out
Next i
err:
End Sub

Answer 4

Есть более элегантные способы сделать это с помощью надстройки, но как насчет этого ... предполагается, что вы используете представление докладчика, где вы можете видеть заметки, но вы можете добавить текст к слайду или что-то еще вместо этого.

Option Explicit
Public StartTime As Date

Sub StartTimer()
    StartTime = Time
    SlideShowWindows(1).View.GotoSlide (SlideShowWindows(1).View.Slide.SlideIndex + 1)
End Sub

Sub ElapsedTime(osh As Shape)

    Dim oNotesText As Shape
    Dim oNextSlide As Slide

    ' what slide are we about to move TO?
    Set oNextSlide = ActivePresentation.Slides(osh.Parent.SlideIndex + 1)

    ' Get a reference to the notes text on that slide (not 100% reliable, but generally works)
    Set oNotesText = oNextSlide.NotesPage.Shapes(2)

    ' Do the time math and add the elapsed time to the notes:
    With oNotesText
        .TextFrame.TextRange.Text = Format(Time - StartTime, "HH:MM:SS") & vbCrLf & .TextFrame.TextRange.Text
    End With

    ' And go to the slide
    SlideShowWindows(1).View.GotoSlide (SlideShowWindows(1).View.Slide.SlideIndex + 1)

End Sub

Добавьте фигуру к первому слайду и назначьте ей настройку действия «Выполнить макрос»: StartTimer. Добавьте фигуру к следующему слайду, назначьте ей настройку действия «Выполнить макрос»: ElapsedTime. Скопируйте и вставьте фигуру из слайда 2 в другие слайды презентация.