Question

我是vba的新手，请提供一些指导。我正在尝试向每个幻灯片（幻灯片区域之外）添加一个文本框，以快速浏览幻灯片的ID和索引。我拼凑了几位来创建下面的代码。它可以正常工作，但是添加到每张幻灯片中的文本框数量是演示文稿中的幻灯片数量（112）而不是1。我还想知道在更改幻灯片时如何适应刷新。

谢谢！

代码如下：

Sub AddSlideInfo()

'Original Source: http://www.pptfaq.com/FAQ01180-Add-presentation-file-name-to-each-slide-master.htm

Dim x As Long
Dim oSh As Shape
Dim oSl As Slide

With ActivePresentation

    On Error Resume Next 'In case the shape does not exist.

    ' On each slide in the presentation:
    For x = 1 To .Slides.Count

    Set oSl = ActivePresentation.Slides(x)

        ' Create a textbox at 0" from left,
        ' -120.24 points from top of slide ( -1.67") from top left corner
        ' Make it 90 points high, 300 points wide 1.25" x 5.5"
        ' Change any of these numbers at will

        For Each oSl In ActivePresentation.Slides

            With oSl

                Set oSh = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=-120, Width:=300, Height:=90)

                ' Give it a name so we can find it later
                oSh.Name = "SlideInfo"

                'Add some formatting and dummy text
                With oSh.TextFrame.TextRange

                    .Font.Name = "Berlin Sans Demi"
                    .Font.Size = 12
                    .Text = _
                    "Slide Info: " & vbNewLine & _
                    "Slide Index: " & oSl.SlideIndex & vbNewLine & _
                    "Slide ID: " & oSl.SlideID 


                End With

            End With

       Next

    Next x

End With

End Sub

Answer 1

您的代码循环遍历所有带有 For x = 1 To .Slides.Count 的幻灯片，然后再次通过 ActivePresentation.Slides 中的每个os遍历所有幻灯片。。您不需要两者。

以下是您的代码的简化版本。它只在幻灯片中循环一次。它会删除SlideInfo文本框（如果存在）（使用On Error Resume Next捕获错误）……但是您可以稍后进行清理：）……，然后每次都重新创建干净的文本框。

Option Explicit

Sub AddSlideInfo()

    Const cShapeName = "SlideInfo"
    Dim oSh As Shape
    Dim oSl As Slide

    On Error Resume Next

    With ActivePresentation
        For Each oSl In ActivePresentation.Slides
            With oSl

                .Shapes(cShapeName).Delete
                Set oSh = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=0, Top:=-120, Width:=300, Height:=90)
                oSh.Name = cShapeName

                'Add some formatting and dummy text
                With oSh.TextFrame.TextRange
                        .Font.Name = "Berlin Sans Demi"
                        .Font.Size = 12
                        .Text = _
                        "Slide Info: " & vbNewLine & _
                        "Slide Index: " & oSl.SlideIndex & vbNewLine & _
                        "Slide ID: " & oSl.SlideID
                End With
            End With
        Next
    End With
End Sub

文本框添加到每个幻灯片实际上添加了很多到每个幻灯片

1 个答案: