How do I add watermark(with shape slanted at 45 degrees-and grayed) to all slides of A PPT Presentation with VBA?
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
And the copy and paste method
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