幻燈片主控臺上的幻燈片數字計數器繼續通過everyslide

Question

我試圖在MS Powerpoint中實現的是一個數字計數器，它可以計算出一個預測數字，例如從1到1000多個幻燈片，如果數字是在幻燈片放映結束之前由於過度播放而到達幻燈片播放器，幻燈片上將顯示1000個幻燈片，說明該演講已結束。

到目前爲止，我發現一些代碼從60倒數到0，但只在一張幻燈片上，我試圖以此爲基礎，但迄今沒有運氣，因爲我缺乏VBA & powerpoint的理解。

任何幫助將大大appriceated。

這裏是倒計時的代碼，適用於只是一張幻燈片下面：

Sub Time_Me2() 
Dim oshp As Shape 
Dim oshpRng As ShapeRange 
Dim osld As Slide 
Dim oeff As Effect 
Dim i As Integer 
Dim Iduration As Integer 
Dim Istep As Integer 
Dim texttoshow As String 
On Error GoTo errhandler 
If ActiveWindow.Selection.ShapeRange.Count > 1 Then 
MsgBox "Please just select ONE shape!" 
Exit Sub 
End If 
Set osld = ActiveWindow.Selection.SlideRange (1) 
Set oshp = ActiveWindow.Selection.ShapeRange(1) 

    oshp.Copy 

'change to suit 
Istep = 1 
Iduration = 60 'in seconds 

For i = Iduration To 0 Step -Istep 
Set oshpRng = osld.Shapes.Paste 
With oshpRng 
.Left = oshp.Left 
.Top = oshp.Top 
End With 
texttoshow = CStr(i) 
oshpRng(1).TextFrame.TextRange = texttoshow 
Set oeff = osld.TimeLine.MainSequence _ 
.AddEffect(oshpRng(1), msoAnimEffectFlashOnce, , msoAnimTriggerAfterPrevious) 
oeff.Timing.Duration = Istep 
Next i 
oshp.Delete 
Exit Sub 
errhandler: 
MsgBox Err.Description 
End Sub 

任何幫助將是驚人的！

Answer 1

這假設您在幻燈片1上添加了一個文本框或其他形狀，並按照您的需要進行了格式化，並在運行代碼之前將其選中。另外，編輯它以將lMaxCount設置爲1000或任何您希望它「粘貼」的數字。

Sub NumberSlides() 
    Dim oSl As Slide 
    Dim oSh As Shape 
    Dim oOriginalShape As Shape 
    Dim x As Long 
    Dim lMaxCount As Long 

    ' edit to suit 
    lMaxCount = 5 

    ' is something selected? 
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then 
     MsgBox "Please select one and only one shape on Slide 1" 
     Exit Sub 
    End If 
    ' is only ONE shape selected? 
    If Not ActiveWindow.Selection.ShapeRange.Count = 1 Then 
     MsgBox "Please select one and only one shape on Slide 1" 
     Exit Sub 
    End If 
    ' is the selected shape on the first slide? 
    If Not ActiveWindow.Selection.ShapeRange(1).Parent.SlideIndex = 1 Then 
     MsgBox "Please select one and only one shape on Slide 1" 
     Exit Sub 
    End If 

    Set oOriginalShape = ActiveWindow.Selection.ShapeRange(1) 

    For x = 2 To ActivePresentation.Slides.Count 
     Set oSl = ActivePresentation.Slides(x) 
     oOriginalShape.Copy 
     Set oSh = oSl.Shapes.Paste(1) 
     If x > lMaxCount Then 
      oSh.TextFrame.TextRange.Text = CStr(lMaxCount) 
     Else 
      oSh.TextFrame.TextRange.Text = CStr(x) 
     End If 
    Next 

End Sub