Текстовое поле, добавленное к каждому слайду На самом деле добавлено много к каждому слайду - PullRequest
Новая
       6

Текстовое поле, добавленное к каждому слайду На самом деле добавлено много к каждому слайду

0 голосов
/ 10 декабря 2018

Я очень новичок в VBA, и мне нужно некоторое руководство, пожалуйста.Я пытаюсь добавить текстовое поле к каждому слайду (за пределами области слайда), чтобы быстро просмотреть идентификатор и индекс слайда.Я собрал несколько битов, чтобы создать код ниже.это работает, однако количество текстовых полей, добавляемых к каждому слайду, равно количеству слайдов в презентации (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

1 Ответ

0 голосов
/ 11 декабря 2018

Ваш код повторяет все слайды с помощью Для x = 1 To .Slides.Count , а затем повторяет все слайды снова с Для каждого oSl In ActivePresentation.Slides .Вам не нужны оба.

Ниже приведена упрощенная версия вашего кода.Это только проходит через слайды один раз.Он удаляет текстовое поле 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
...