Как вставить водяной знак на все слайды презентации PowerPoint с помощью VBA?

Question

Как добавить водяной знак (с наклонной формой 45 градусов и серым цветом) на все слайды презентации PPT с VBA?

Я создал поле ввода, чтобы принять строковую переменную, на которой будет нанесен водяной знаквсе слайды PPT.Я также попытался создать форму и передать введенную в нее переменную.Теперь мне сложно вставить эту форму на остальные слайды презентации, но отправить назад.

 Option Explicit
    Public thepresentn As Presentation
    Public theslide As Slide
    Public thetex As Shape
    Sub ConfidentialProject()

    Set thepresentn = ActivePresentation
    Set theslide = ActivePresentation.Slides.Item(1)
    Set thetex = theslide.Shapes.Item(1)
    Dim WORD As String

    WORD = InputBox("Please Enter the text you want to appear as Watermark", 
    "Enter Text Here:")
    thetex.TextFrame.TextRange.Text = WORD

   End Sub

Я ожидаю, что водяной знак на первом слайде будет реплицирован на все остальные слайды.

Answer 1

Я предложил вам два решения.Первый использует мастер слайдов, а второй использует запрошенный вами метод.

Это будет работать путем изменения мастера слайдов.Не копировать и вставлять.если вам нужно скопировать и вставить, пожалуйста, укажите, что копировать и вставлять (текст, изображение и т. д.)

    Option Explicit

    Sub AddWaterMarkMaster()
        Dim intI As Integer
        Dim strWaterMark As String
        Dim intShp As Integer

        strWaterMark = InputBox("Please Enter the text you want to appear as Watermark", _
                                "Enter Text Here:")

        With ActivePresentation.SlideMaster
            .Shapes.AddLabel msoTextOrientationHorizontal, .Width - 100, .Height - 100, 100, 100
            intShp = .Shapes.Count
            .Shapes.Item(intShp).TextFrame.TextRange = strWaterMark
            .Shapes.Item(intShp).Left = .Width - .Shapes.Item(intI).Width
            .Shapes.Item(intShp).Top = .Height - .Shapes.Item(intI).Height
        End With
    End Sub

и метод копирования и вставки

    Sub AddWaterMarkCopyPaste()
        Dim intI As Integer
        Dim intShp As Integer
        Dim strWaterMark As String

        strWaterMark = InputBox("Please Enter the text you want to appear as Watermark", _
                                "Enter Text Here:")

        With ActivePresentation.Slides.Item(1)
            .Shapes.AddLabel msoTextOrientationHorizontal, .Master.Width - 100, .Master.Width - 100, 100, 100
            intShp = .Shapes.Count
            .Shapes.Item(intShp).TextFrame.TextRange = strWaterMark
            .Shapes.Item(intShp).Left = .Master.Width - .Shapes.Item(intShp).Width
            .Shapes.Item(intShp).Top = .Master.Height - .Shapes.Item(intShp).Height
            .Shapes.Item(intShp).Copy
        End With


        For intI = 2 To ActivePresentation.Slides.Count
            With ActivePresentation.Slides(intI)
                .Shapes.Paste
                intShp = .Shapes.Count
                .Shapes.Item(intShp).Left = .Master.Width - .Shapes.Item(intShp).Width
                .Shapes.Item(intShp).Top = .Master.Height - .Shapes.Item(intShp).Height
            End With
        Next intI

    End Sub