且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2021-08-04 23:09:44

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

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