如何贴在我的VBA PowerPoint演示文稿的所有幻灯片水印？

Question

如何添加水印（与形状在45度和灰色倾斜）与VBA一个PPT演示文稿的所有幻灯片？

我创建了一个输入框接受将在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