How do I paste a watermark on all slides of my Pow

2019-09-02 08:40发布

How do I add watermark(with shape slanted at 45 degrees-and grayed) to all slides of A PPT Presentation with VBA?

I created an input box to accept a string variable that would be watermarked on all slides of a PPT. I also tried creating a shape and feeding the variable inputted into it. I now have a challenge pasting this shape on the rest of the slides in the presentation but sending backward.

 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

I expect the watermark on the first slide to be replicated on all other slides.

1条回答
smile是对你的礼貌
2楼-- · 2019-09-02 09:14

I have offered you TWO solutions. The first is using the slide master and the second is using the method you requested.

This will work by modifying your slide master. Not copy and paste. if you need copy and paste then, Please specify what to copy and paste (Text, Picture, etc....)

    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

And the copy and paste method

    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

查看更多
登录 后发表回答