|
|
Question : Watermark macro
|
|
I need some help with a watermark macro. Couldn't find anything on EE, even though this must have been asked hundreds of times.
What I need is a macro that will insert the words "draft" on my document when I run it. If the document already has a watermark, it has to be removed, and instead inser the "draft" watermark. Then if I run the macro again it will remove the watermark. That way I can create a botton to use it. And I can easly change the watermark to eg. "copy" with a similar macro.
Hope this can be done.
|
Answer : Watermark macro
|
|
Oops. Forgot to post the code
Sub InsertWaterMarks() Dim sec As Section Dim hdr As HeaderFooter Dim sh As Shape Dim i As Integer Dim shHeaders As Shapes Dim strText As String Dim Doc As Document Set Doc = ActiveDocument strText = "COPY" Set shHeaders = Doc.Sections(1).Headers(1).Shapes 'Delete any existing watermarks For Each sh In shHeaders If InStr(sh.Name, "PowerPlusWaterMarkObject") = 1 Then sh.Delete End If Next sh 'Add shape to headers shapes collection after selecting each header Doc.Range.Select For Each sec In Doc.Sections For Each hdr In sec.Headers If sec.Index = 1 Or hdr.LinkToPrevious = False Then i = i + 1 hdr.Range.Select Set sh = shHeaders.AddTextEffect(msoTextEffect1, _ strText, "Arial", 1, False, False, 0, 0) sh.Name = "PowerPlusWaterMarkObject" & i sh.TextEffect.NormalizedHeight = False sh.Line.Visible = msoTrue sh.Line.Weight = 0.25 sh.Line.DashStyle = msoLineSolid sh.Line.Style = msoLineSingle sh.Fill.Visible = msoFalse sh.Fill.Solid sh.Line.ForeColor.RGB = RGB(0, 0, 0) sh.Line.BackColor.RGB = RGB(255, 255, 255) sh.Fill.Transparency = 0# sh.Rotation = 315 sh.LockAspectRatio = True sh.Height = CentimetersToPoints(6.88) sh.Width = CentimetersToPoints(13.77) sh.WrapFormat.AllowOverlap = True sh.WrapFormat.Side = wdWrapNone sh.WrapFormat.Type = 3 sh.RelativeHorizontalPosition = _ wdRelativeVerticalPositionMargin sh.RelativeVerticalPosition = _ wdRelativeVerticalPositionMargin sh.Left = wdShapeCenter sh.Top = wdShapeCenter End If Next hdr Next sec ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument If ActiveWindow.View.SplitSpecial = wdPaneNone Then ActiveWindow.ActivePane.View.Type = wdPrintView Else ActiveWindow.View.Type = wdPrintView End If End Sub
|
|
|
|
|