如何使用 VBA 在 PowerPoint 演示文稿的所有幻灯片上粘贴水印？

如何使用VBA向PPT演示文稿的所有幻灯片添加水印（形状倾斜45度且呈灰色）？

我创建了一个输入框来接受一个字符串变量，该变量将在 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

我希望第一张幻灯片上的水印能够复制到所有其他幻灯片上。

我为您提供了两种解决方案。第一个是使用幻灯片母版，第二个是使用您请求的方法。

这可以通过修改幻灯片母版来实现。不是复制和粘贴。如果您需要复制和粘贴，请指定要复制和粘贴的内容（文本、图片等）。

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