Question

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

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

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

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

1 个答案: