Vba 添加到每张幻灯片的文本框实际上为每张幻灯片添加了许多文本框

Vba 添加到每张幻灯片的文本框实际上为每张幻灯片添加了许多文本框,vba,powerpoint,Vba,Powerpoint,我是vba的新手,需要一些指导。我试图在每张幻灯片中添加一个文本框(在幻灯片区域之外),以便快速浏览幻灯片的ID和索引。我已经拼凑了几个位来创建下面的代码。它可以工作,但是添加到每个幻灯片的文本框的数量是演示文稿中的幻灯片数量(112),而不是1。我还想知道,当对幻灯片进行更改时,我如何使其适应刷新 提前谢谢 代码如下: Sub AddSlideInfo() 'Original Source: http://www.pptfaq.com/FAQ01180-Add-presentation-fi

我是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  

对于x=1到.slides,代码使用循环浏览所有幻灯片。计数,然后在ActivePresentation.slides中的每个oSl中使用再次循环浏览所有幻灯片。你不需要两者兼而有之

以下是代码的简化版本。它只在幻灯片中循环一次。如果存在SlideInfo文本框,它将删除该文本框(使用错误恢复下一步捕获错误)。。。但你可以稍后再清理:)。。。然后每次都干净地重新创建文本框

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