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

本文介绍了如何使用 VBA 在 PowerPoint 演示文稿的所有幻灯片上粘贴水印?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

如何在带有 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