如何使用 VBA 在 PowerPoint 演示文稿的所有幻灯片上粘贴水印? [英] How do I paste a watermark on all slides of my PowerPoint Presentation with VBA?

问题描述

如何在带有 VBA 的 A PPT 演示文稿的所有幻灯片中添加水印(形状倾斜 45 度并呈灰色)?

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

我创建了一个输入框来接受一个字符串变量，该变量将在 PPT 的所有幻灯片上加水印.我还尝试创建一个形状并输入输入的变量.我现在在将这个形状粘贴到演示文稿中的其余幻灯片上但向后发送时遇到了挑战.

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.

推荐答案

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

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

以及复制粘贴方法

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

这篇关于如何使用 VBA 在 PowerPoint 演示文稿的所有幻灯片上粘贴水印?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！