PDA

View Full Version : Word 2010 - Count number of sections & remove watermark



NicoleJones
06-01-2011, 04:59 PM
Hi

I have a document that is pulling properties from a document managment system. One of these properties is the revision 'DRAFT' / 'FINAL' information. I am then using this information to insert a custom watermark if the property is 'DRAFT' and removing all exisiting watermarks if it is 'FINAL'.

As the watermark name/number changes each time one of them is inserted I have removed the naming line out of the code (this is inserting without any issue).

Can some one please help me with two things


the code to count the number of sections in the document and
be able to select and remove any of the watermarks with using the name, can this be done?Thank you in advance for your assistance.

Nicole

Frosty
06-01-2011, 05:17 PM
Don't know if you want to count the number of sections or simply iterate through the sections... but

Dim i as integer
For i = 1 to ActiveDocument.Sections.Count
Msgbox ActiveDocument.Sections(i)
Next

Will iterate through the sections... so will
Dim oSec as Section
For each oSec in ActiveDocument.Sections
msgbox oSec.Index
Next

As for deleting a watermark... unless something is different in Word 2010, watermarks are just graphics. However, they tend to have some distinguishing characteristics (i.e., fading, inserted at specific places perhaps) which can be very firm/company/document specific.

Note: you don't have to iterate through the sections in order to iterate through the .Shapes collection. You could
Dim oShape as Shape
For Each oShape in ActiveDocument.Shapes
With oShape
msgbox .Name
End with
Next

From there--depending on what your naming convention is (in earlier versions of Word, at least, if you were inserting shapes with a specific name, you would typically put a random number on the name as well, to avoid some bugs, so you can use string manipulation/analysis (InStr function, Left function, etc) to see if the name of the shape without the random number was something you were looking for.

If none of the above helps, perhaps you can set up a mock up of the document you'd like to delete all the water marks from based on whatever properties you're using (a draft and a final document), and then I or someone else could be a bit more specific.

NicoleJones
06-01-2011, 08:16 PM
Hi Frost

Thank you so much for your assistance, with your code I have been able to solve my issue of counting the sections to input the 'watermark'. I however now can not remove them and really have not clue on where to start to do so.

I have attached what I have come up with so far, if you could help me with the rest I would be most appreciative.

Thx again

Nicole

macropod
06-01-2011, 09:04 PM
Hi Nicole,

The foolowing macro removes all watermarks (which can be in any of the headers or footers in each Section in the document):
Sub Demo()
Application.ScreenUpdating = False
Dim RngSel As Range, Scn As Section, HdFt As HeaderFooter, iView As Long
With ActiveDocument
Set RngSel = Selection.Range
iView = ActiveWindow.View.Type
For Each Scn In .Sections
For Each HdFt In Scn.Headers
HdFt.Range.Select
WordBasic.RemoveWatermark
Next
For Each HdFt In Scn.Footers
HdFt.Range.Select
WordBasic.RemoveWatermark
Next
Next
End With
RngSel.Select
ActiveWindow.View.Type = iView
Set RngSel = Nothing
Application.ScreenUpdating = True
End Sub

NicoleJones
06-01-2011, 09:48 PM
Hi Paul

Sorry the document I loaded before didnt have the code in it (I think I must of saved it as a docx before hand and removed the code....oh well lesson learned).

I inserted the code that you gave me, however nothing happens. What my goal is (from the attached document) I am wanting to remove the image 'DRAFT' (which was inserted by a custom watermark) from all of the sections while leaving all other details in the headers and footers.

Cheers

Nicole

macropod
06-01-2011, 11:33 PM
Hi Nicole,

The code removes custom watermarks for me. I have examined your document and it appears your 'watermark' has not been inserted using Word's watermarking tools - it can't even be deleted using them. Your 'Watermark_Scope' macro suggests that what you've done is to simply insert a picture with a 'watermark' layout - either that or you've deleted the code that names the shape (that code would look something like Selection.ShapeRange.Name = "WordPictureWatermark26161898"), without which the watermark deletion won't work and you'll need a different approach. If your 'watermark' is the only shape in each header or footer, then it's a simple matter of coding a macro to delete the first such shape in each of them - you'll need to test for linked headers, though, both to avoid errors and to expedite execution.

NicoleJones
06-02-2011, 02:26 AM
Hi again,

Your correct that I have removed the watermark naming, I did so because the numbering is always different and didnt know how to name it so that it was consistent and easily removed. Do you have any suggestions on how I can do this as there are other images included in the headers and footers that I cannot have removed.

Thx for your help

Nicole

macropod
06-02-2011, 04:42 AM
Hi Nicole,

You can deal with those issues by replacing your 'Insert_Watermark' and 'Watermark_Scope' subs with the 'Insert_Watermark' sub below. The 'Delete_Watermark' sub that follows deletes the watermarks. The new 'Insert_Watermark' assigns a name to each inserted 'watermark' and the 'Delete_Watermark' sub uses those names to manage the deletions.Sub Insert_Watermark()
Application.ScreenUpdating = False
Dim i As Long, j As Long, HdFt As HeaderFooter, Shp As Shape
DefaultUser
With ActiveDocument
For i = 1 To .Sections.Count
For Each HdFt In .Sections(i).Headers
j = j + 1
With HdFt
If .LinkToPrevious = False Then
Set Shp = HdFt.Shapes.AddPicture(FileName:= _
strUser & "\Application Data\Microsoft\Templates - Workgroup\DRAFT.gif", _
LinkToFile:=False, SaveWithDocument:=True)
With Shp
.Name = "WaterMark" & Format(j, "0000")
.PictureFormat.Brightness = 0.5
.PictureFormat.Contrast = 0.5
.LockAspectRatio = True
.Width = CentimetersToPoints(16.5)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
End If
End With
Next
Next
End With
End Sub

Sub Delete_Watermark()
Application.ScreenUpdating = False
Dim i As Long, HdFt As HeaderFooter, Shp As Shape
With ActiveDocument
For i = 1 To .Sections.Count
For Each HdFt In .Sections(i).Headers
With HdFt
If .LinkToPrevious = False Then
For Each Shp In .Range.ShapeRange
If InStr(Shp.Name, "WaterMark") > 0 Then Shp.Delete
Next
End If
End With
Next
Next
End With
End Sub

NicoleJones
06-02-2011, 01:37 PM
Paul,
You are an absolute god send, you have saved me hours and hours of frustration.

Thank you so much for your help it works perfectly.
Nicole