#1
|
|||
|
|||
VBA code to align watermarks
Hi, I have used some code from the net to insert watermarks, but need help to position these watermarks on the document correctly. Below is the code used to insert these watermarks. Code:
Set Shp = HdFt.Shapes.AddTextEffect(msoTextEffect1, _ "CONFIDENTIAL", "Arial Narrow", 38, False, False, 0, 0) With Shp .Name = "PowerPlusWaterMarkObject" & Format(Now, "YYMMDD") & Format(HdFt.Index, "00") .TextEffect.NormalizedHeight = False .Line.Visible = False .Fill.Visible = True .Fill.Solid .Fill.ForeColor.RGB = RGB(192, 192, 192) .Fill.Transparency = 0.5 .Rotation = 315 .LockAspectRatio = True .Height = InchesToPoints(3.29) .Width = InchesToPoints(6.85) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .Left = InchesToPoints(-0.5) .WrapFormat.Type = 3 .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin .RelativeVerticalPosition = wdRelativeVerticalPositionMargin .Top = InchesToPoints(3) End With .Range.FormattedText.ShowAll = False Next End With Last edited by macropod; 11-20-2013 at 12:40 PM. Reason: Added code tags and formatting |
#2
|
|||
|
|||
The code you posted will not run or compile. What help do you need. Where do you want the WM positioned?
|
#3
|
|||
|
|||
Hi Greg,
I need the WM alignment to be vertically and horizontally centered relative to page. I did not include all the code in my previous post. Below is the complete code. Code:
Dim Shp As Shape, HdFt As HeaderFooter With ActiveDocument On Error Goto Errhandler 'Add the watermark to each header in the first Section With .Sections.First For Each HdFt In .Headers Set Shp = HdFt.Shapes.AddTextEffect(msoTextEffect1, _ "CONFIDENTIAL", "Arial Narrow", 38, False, False, 0, 0) With Shp .Name = "PowerPlusWaterMarkObject" & Format(Now, "YYMMDD") & Format(HdFt.Index, "00") .TextEffect.NormalizedHeight = False .Line.Visible = False .Fill.Visible = True .Fill.Solid .Fill.ForeColor.RGB = RGB(192, 192, 192) .Fill.Transparency = 0.5 .Rotation = 315 .LockAspectRatio = True .Height = InchesToPoints(3.29) .Width = InchesToPoints(6.85) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .Left = InchesToPoints(-0.5) .WrapFormat.Type = 3 .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin .RelativeVerticalPosition = wdRelativeVerticalPositionMargin .Top = InchesToPoints(3) End With .Range.FormattedText.ShowAll = False Next End With With .ActiveWindow.View .ShowMarkupAreaHighlight = False .ShowComments = False .ShowRevisionsAndComments = False End With .FormattingShowClear = True End With Set Shp = Nothing Last edited by macropod; 11-20-2013 at 01:45 PM. Reason: Added code tags & formatting |
#4
|
|||
|
|||
Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim Shp As Shape, HdFt As HeaderFooter With ActiveDocument 'Add the watermark to each header in the first Section With .Sections.First For Each HdFt In .Headers Set Shp = HdFt.Shapes.AddTextEffect(msoTextEffect1, _ "CONFIDENTIAL", "Arial Narrow", 38, False, False, 0, 0) With Shp .Name = "PowerPlusWaterMarkObject" & Format(Now, "YYMMDD") & Format(HdFt.Index, "00") .TextEffect.NormalizedHeight = False .Line.Visible = False .Fill.Visible = True .Fill.Solid .Fill.ForeColor.RGB = RGB(192, 192, 192) .Fill.Transparency = 0.5 .Rotation = 315 .LockAspectRatio = True .Height = InchesToPoints(3.29) .Width = InchesToPoints(6.85) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .WrapFormat.Type = 3 .RelativeHorizontalPosition = wdRelativeVerticalPositionPage .RelativeVerticalPosition = wdRelativeVerticalPositionPage .Left = wdShapeCenter .Top = wdShapeCenter End With .Range.FormattedText.ShowAll = False Next End With With .ActiveWindow.View .ShowMarkupAreaHighlight = False .ShowComments = False .ShowRevisionsAndComments = False End With .FormattingShowClear = True End With Set Shp = Nothing End Sub Last edited by macropod; 11-20-2013 at 01:47 PM. Reason: Added code tags & formatting |
#5
|
|||
|
|||
Thanks a lot Greg...this works beautifully.
I have two other concerns though. I have created a DeleteWaterMark macro which was working 100% first run, but now after inserting my "new" watermark, I have to run the DeleteWaterMark macro twice before the watermark is removed. Also for testing purposes, when I try to insert 2 different watermarks on the same document, the second watermark "hangs" on the top half of the header instead of just replacing the first one (hope I'm making sense). How can I resolve this? Below is the DeleteWaterMark macro. Thanks so much for your help! Code:
Sub DeleteWatermark() Dim oSection As section Dim oHeader As HeaderFooter Dim oRng As Range Dim oShape As Shape On Error Goto Errhandler For Each oSection In ActiveDocument.Sections For Each oHeader In oSection.Headers If oHeader.Exists Then Set oRng = oHeader.Range oRng.End = oRng.Paragraphs(1).Range.End - 1 For Each oShape In oRng.ShapeRange If oShape.Type = 15 Then oShape.Delete Next oShape End If Next oHeader Next oSection Errhandler: MsgBox "Watermark successfully removed." End Sub Last edited by macropod; 11-20-2013 at 01:49 PM. Reason: Added code tags & formatting |
#6
|
|||
|
|||
Catty,
For Each loops when dealing with objects and deleting is often problematic. Also before inserting watermarks you should ensure the previous ones are deleted first by adding a call to your delete macro: Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim Shp As Shape, HdFt As HeaderFooter DeleteWatermark With ActiveDocument 'Add the watermark To each header In the first Section With .Sections.First For Each HdFt In .Headers Set Shp = HdFt.Shapes.AddTextEffect(msoTextEffect1, _ "CONFIDENTIAL", "Arial Narrow", 38, False, False, 0, 0) With Shp .Name = "PowerPlusWaterMarkObject" & Format(Now, "YYMMDD") & Format(HdFt.Index, "00") .TextEffect.NormalizedHeight = False .Line.Visible = False .Fill.Visible = True .Fill.Solid .Fill.ForeColor.RGB = RGB(192, 192, 192) .Fill.Transparency = 0.5 .Rotation = 315 .LockAspectRatio = True .Height = InchesToPoints(3.29) .Width = InchesToPoints(6.85) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .WrapFormat.Type = 3 .RelativeHorizontalPosition = wdRelativeVerticalPositionPage .RelativeVerticalPosition = wdRelativeVerticalPositionPage .Left = wdShapeCenter .Top = wdShapeCenter End With .Range.FormattedText.ShowAll = False Next End With With .ActiveWindow.View .ShowMarkupAreaHighlight = False .ShowComments = False .ShowRevisionsAndComments = False End With .FormattingShowClear = True End With Set Shp = Nothing End Sub Sub DeleteWatermark() Dim oSection As Section Dim oHeader As HeaderFooter Dim oShape As Shape Dim lngIndex As Long For Each oSection In ActiveDocument.Sections For lngIndex = 1 To 3 Set oHeader = oSection.Headers(lngIndex) For Each oShape In oHeader.Range.ShapeRange If oShape.Type = 15 Then oShape.Delete Next oShape Next lngIndex Next oSection End Sub Last edited by macropod; 11-20-2013 at 01:55 PM. Reason: Added code tags & formatting |
#7
|
||||
|
||||
Hi folks,
When posting code, please use the code tags. They're on the 'Go Advanced' tab. Doing this will preserve the code's structure and make it much easier for everyone reading your posts to understand what your code is doing. I've edited all your code posts in this thread to that end.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Paul,
Sorry, I should have known (did actually know) that. I was just in a hurry and missed it this time. |
#9
|
|||
|
|||
Thanks so much for all your help Greg. Much appreciated, both macros work wonderfully. Thanks again
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to align texts so they all end at the same line | patehi | Word | 3 | 05-25-2013 11:47 PM |
Resize and align | AndyDDUK | PowerPoint | 9 | 11-09-2012 05:23 AM |
Clipart and Watermarks | Maureen | Office | 3 | 09-30-2011 02:53 AM |
Watermarks on the web | David S | Word | 0 | 07-28-2011 07:54 AM |
Question on watermarks | kknutson | Word | 0 | 04-26-2007 04:12 PM |