1

我试图在 MS Powerpoint 中实现的是一个数字计数器，它可以在多张幻灯片上计数到一个预先确定的数字，即从 1 到 1000，如果由于过度运行而在幻灯片放映结束之前达到了这个数字，它只会在演讲结束的幻灯片上显示 1000。

到目前为止，我发现了一些从 60 倒数到 0 的代码，但只在一张幻灯片上，我试图以此为基础，但由于我缺乏对 VBA 和 powerpoint 的理解，到目前为止还没有运气。

任何帮助将不胜感激。

以下是仅适用于下面一张幻灯片的倒计时代码：

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

任何帮助都会很棒！

4

1 回答 1

0

这假定您在幻灯片 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
于 2012-10-03T15:02:25.387 回答