PDA

View Full Version : Solved: Macro to create a "Draft" Watermark stamp for workbooks



xluser2007
04-18-2008, 08:03 PM
Hi All,

When sending some workbooks to clients, there is occasionally the need to draft stamp all the worksheets.

This is at the moment a tedious manual process where a Wordart draft stamp is created (as attached) and copy pasted manually across all the worksheets. There are over 35 workbooks, with over 10 worksheets each so this becomes very laborious indeed!

As such I need help writing 2 such routines that involve opening up a target-workbook (workbook to paste stamp in) and the draft-watermark workbook (workbook which contains a wordart stamp, as attached) and:

Macro 1. Paste the draft watermark at the 'centre' of each printable page in each worksheet for the target workbook.

Macro 2. Remove all added watermarks in the target workbook and its corresponding worksheets.

The reason why I have saved the Watermark in a separate workbook (as attached) is because the Watermark is formatted corectly as a WwordArt object and saving it as an image causes a white (not transparent background to exist around it which is undesirable when pasting a new workbooks).

The wtaremark workbook for test purposes is in C:\Draft_watermark_sample.xls.

The target workbook (to paste watermark in) is:

C:\Targetbook.xls (just a blank book at the moment).

Would anyone please guide me in how to go about writing teh above 2 routine (I'm not very familiar on how to add and delete a collection of objects such as pictures and how to put them at the centre of each printing area of worksheets)

regards

tstav
04-19-2008, 01:31 AM
Hi xluser2007,

Codewise speaking, I'm afraid I haven't come up with anything that would wrock me off my seat... Hope somebody else does...

I just did it manually (like you).
Let me tell you how I do it, maybe it's just exactly what you do, maybe not.

I first copy the watermark. Fine.
Then I activate the other workbook and go to menu View>Preview Page Breaks.
I zoom out so that I can see as many printpages as possible.
I do the initial paste to get the watermark in this workbook.
From then on, I Ctrl-click-drag and create copies of the watermark inside all pages.

No big deal, really. It does take some time but actually, I doesn't seem to be such a drag.

Regards, tstav

tstav
04-19-2008, 01:37 AM
Reading your initial post again, I see that I could first copy the watermark to every worksheet (by code) and then do some manual labor (like in my previous post).
I'll look into it again.

xluser2007
04-19-2008, 01:41 AM
Hi tstav,

Thanks for your reply, much appreciated :).

The way you have described is very similar to the way I currently do it. Though your suggestion of activating page break preview mode is really good, I just roughly place it in the 'centre' of the worksheet (quite crude).

I completely agree with you that for one workbook, it isn't a big deal to do this. Hoever there are 35 books with over 10 worksheets in each one, and the process is carried out monthly, so it does take considerable time and (I believe unnecessary) manual work.

Again, thanks for your resposne, If you do in the mean-time find a way to macro-paste the watermark into a test target workbook, please let me know.

regards

xluser2007
04-19-2008, 01:44 AM
Hi tstav,

Just got your post #3 as I was typing in post #4.

Thanks for looking into this further.

One thing I forgot to mention is that finding the centre of a printable page may actually be easier to using VBA than the "manual zoom out and paste where it looks good approach" for the draft-watermark.

I don't have the grasp to tackle these probs, so I ask helpful experts such as yourself and others here..

tstav
04-19-2008, 02:05 AM
This code will copy/paste the watermark to all open workbooks.
You may revise the code according to your needs.
If for example all your files are in one folder, you can open the files one by one and do the paste in all sheets of each one.
Another way would be to first open all files and then loop through them doing the paste accordingly.
Sub WatermarkAdd()
Dim wbk As Workbook
Dim sht As Worksheet
Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy

For Each wbk In Workbooks '<-- I suppose all files are open
'Exclude the workbooks you don't want the watermark to go into
If wbk.name <> ThisWorkbook.name And wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
sht.Paste
Next
End If
Next
Application.CutCopyMode = False
End Sub


This code will delete all watermarks. You may need to revise it according to your needs.
Sub WaterMarkDelete()
Dim wbk As Workbook
Dim sht As Worksheet
On Error Resume Next
For Each wbk In Workbooks
'Exclude the workbooks you want to retain the watermark
If wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
sht.Shapes("Draft_Watermark").Delete
Next
End If
Next
End Sub


Edit: I still cannot come up with a way to center the watermark in the printable pages...

xluser2007
04-19-2008, 02:42 AM
Hi tstav,

Thanks! That works really well!

Apart from centering that's pretty much a full solution.

I have looked all over for centering objects but haven't found anything on it as yet.

If anyone could finish this last part, that would be awesome.

Thanks again tstav for your solution. :hi:

regards

tstav
04-19-2008, 03:00 AM
If anyone could finish this last part, that would be awesome

Yeah, I too, am in anticipation of an answer to that last part...

xluser2007
04-19-2008, 03:09 AM
tstav,

I've had another thought. Instead of draft-stamping every single page, is it possible (and possible easier) to paste it in the centre of a UsedRange of a worksheet?

That is for each wksht.Usedrange in workbook, we can get the center by dividing the width and the length of the UsedRange rectangle by 2, and place it there.

I'm not sure how to go about this, but it is a slightly different (and a more tractable approach). approach.

Some relevant links I found, but can;t get my head around are:

http://www.ozgrid.com/forum/showthread.php?t=41714

http://www.ozgrid.com/forum/showthread.php?t=55993

regards

BTW

How is a printable-range even defined in VBA? i.e. worksheets, workbooks are defined objects, is there one for the printable ranges that you see when you enter View > Page Break Preview?

tstav
04-19-2008, 04:27 AM
Excellent thoughts xluser2007!

I'm working on them.

tstav
04-19-2008, 07:29 AM
Ok, let me first put it down in words.

First I locate all the page breaks in each worksheet and store them in two arrays (one for the horizontal pagebreaks and one for the vertical).
Knowing where these pagebreaks are (what columns or rows they separate), enables me to know where each printpage starts and ends, and so I can calculate each printpage's hight, width etc.
From then on, all that is left to do is calculate the exact position of each watermark within this printpage (in our case the center position).

What I noticed is that in pages that are "smaller" than the normal ones (due to having very few data inside them), the watermark tends to "overflow" in the neighbouring printpages (which is of course quite natural).

I'm sure the code can get better, since this is only a first approach to such a unique requirement...

Here is the code. I have already done some testing but I'm waiting to hear from you for more.

PS. Never forget to do the testing on test files (not the originals)

Sub WatermarkAdd()
Dim wbk As Workbook
Dim sht As Worksheet
Dim vertBreaks() As Long, horzBreaks() As Long, vert As Long, horz As Long
Dim rng As Range
'Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy

For Each wbk In Workbooks
'Exclude the workbooks you don't want the watermark to go into
If wbk.name <> ThisWorkbook.name And wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
Erase horzBreaks()
Erase vertBreaks()
GetPageBreaks horzBreaks(), vertBreaks()
With sht
'Get each printable page and center the watermark inside it
For horz = 1 To UBound(horzBreaks) - 1
For vert = 1 To UBound(vertBreaks) - 1
Set rng = .Range(.Cells(horzBreaks(horz), vertBreaks(vert)), .Cells(horzBreaks(horz + 1) - 1, vertBreaks(vert + 1) - 1))
.Paste
'Center watermark in printable range
.Shapes(.Shapes.count).Top = rng.Top + (rng.Height - .Shapes(.Shapes.count).Height) / 2
.Shapes(.Shapes.count).Left = rng.Left + (rng.Width - .Shapes(.Shapes.count).Width) / 2
Next
Next
End With
Next
End If
Next
Application.CutCopyMode = False
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub GetPageBreaks(ByRef horzBreaks() As Long, ByRef vertBreaks() As Long)
Dim rng As Range
Dim i As Long, k As Long
Set rng = ActiveSheet.UsedRange
ReDim vertBreaks(1 To 1)
vertBreaks(1) = 1
ReDim horzBreaks(1 To 1)
horzBreaks(1) = 1
'Get the vertical Separator lines
k = 1
For i = 2 To rng.Columns.count
If Columns(i).PageBreak = xlPageBreakAutomatic Or Columns(i).PageBreak = xlPageBreakManual Then
k = k + 1
ReDim Preserve vertBreaks(1 To k)
vertBreaks(k) = i
End If
Next
k = k + 1
ReDim Preserve vertBreaks(1 To k)
vertBreaks(k) = rng.Columns.count + 1
'Get the horizontal Separator lines
k = 1
For i = 2 To rng.Rows.count
If Rows(i).PageBreak = xlPageBreakAutomatic Or Rows(i).PageBreak = xlPageBreakManual Then
k = k + 1
ReDim Preserve horzBreaks(1 To k)
horzBreaks(k) = i
End If
Next
k = k + 1
ReDim Preserve horzBreaks(1 To k)
horzBreaks(k) = rng.Rows.count + 1
End Sub


And this is the code to delete watermarks, which has been upgraded a little
Sub WaterMarkDelete()
Dim wbk As Workbook
Dim sht As Worksheet
Dim i As Integer
On Error Resume Next
For Each wbk In Workbooks
'Exclude the workbooks you want to retain the watermark
If wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
For i = sht.Shapes.count To 1 Step -1
sht.Shapes(i).Delete
Next
Next
End If
Next
End Sub

xluser2007
04-19-2008, 07:01 PM
Hi tstav,

Firstly thanks for your efforts I really appreciate them! Also my apologies for not replying sooner, as we're in defferent timezones, one's night is the other's day :).

I just tried testing it on a copy of rather large and complex workbook (one of the one's I'm hoping to apply this to eventually).

The macro ran through, but it ended upo pasting it to the top-left hand corner of each workbook, and only once, not on each page within each worksheet.

The positioning seems to be working - but only in the top left hand corner of the first page for some reason.

I have attached a screenshot as below for a sample page.

I'll have a play around with it more. Please let me know if you find a solution.

Thanks again.

tstav
04-19-2008, 10:41 PM
Hi xluser2007,

mistake already traced. Working on it.

tstav

tstav
04-20-2008, 12:17 AM
Here's the news.

It seems that VBA cannot trace Pagebreaks on a sheet when the relevant sheet is not activated. Just like it cannot select a cell unless the relevant sheet is activated.

Since in my tests I always worked having sheets activated one after the other (in order to be able to watch the flow of the code), I certainly couldn't trace that 'drawback'.

Due to that, we also can't have screenupdating turned off, so we will have to watch the show roll on...

There was also a mistake in the code but I fixed it.

Anyways... Now things seem to have been straightened up.

I tested on a multi-sheet, multi-page workbook and it went OK.
You can test it more and let me know again.

I'll be away for a few hours, so see you later.

tstav

Sub WatermarkAdd()
Dim wbk As Workbook
Dim sht As Worksheet
Dim vertBreaks() As Long, horzBreaks() As Long, vert As Long, horz As Long
Dim rng As Range
'Application.ScreenUpdating = False
'Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy
For Each wbk In Workbooks
'Exclude the workbooks you don't want the watermark to go into
If wbk.name <> ThisWorkbook.name And wbk.name <> "Draft_watermark_sample.xls" And wbk.name <> "VBXL_ExtraMenu.xls" Then
For Each sht In wbk.Worksheets
'Debug.Print sht.name
sht.Activate
Erase horzBreaks()
Erase vertBreaks()
GetPageBreaks sht, horzBreaks(), vertBreaks()
With sht
'Get each printable page and center the watermark inside it
For horz = 1 To UBound(horzBreaks) - 1
For vert = 1 To UBound(vertBreaks) - 1
Set rng = .Range(.Cells(horzBreaks(horz), vertBreaks(vert)), .Cells(horzBreaks(horz + 1) - 1, vertBreaks(vert + 1) - 1))
.Paste
'Center watermark in printable range
.Shapes(.Shapes.count).Top = rng.Top + (rng.Height - .Shapes(.Shapes.count).Height) / 2
.Shapes(.Shapes.count).Left = rng.Left + (rng.Width - .Shapes(.Shapes.count).Width) / 2
Next
Next
End With
Next
End If
Next
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetPageBreaks(ByVal sht As Worksheet, ByRef horzBreaks() As Long, ByRef vertBreaks() As Long)
'VBAX, xluser2007
Dim rng As Range
Dim i As Long, k As Long
Set rng = sht.UsedRange
ReDim vertBreaks(1 To 1)
vertBreaks(1) = 1
ReDim horzBreaks(1 To 1)
horzBreaks(1) = 1
'Get the vertical Separator lines
k = 1
For i = 2 To rng.Columns.count
If Columns(i).PageBreak = xlPageBreakAutomatic Or Columns(i).PageBreak = xlPageBreakManual Then
k = k + 1
ReDim Preserve vertBreaks(1 To k)
vertBreaks(k) = i
End If
Next
'If last break was prior to last column, add final break
If vertBreaks(k) < rng.Columns.count Then
k = k + 1
ReDim Preserve vertBreaks(1 To k)
vertBreaks(k) = rng.Columns.count + 1
End If
'Get the horizontal Separator lines
k = 1
For i = 2 To rng.Rows.count
If Rows(i).PageBreak = xlPageBreakAutomatic Or Rows(i).PageBreak = xlPageBreakManual Then
k = k + 1
ReDim Preserve horzBreaks(1 To k)
horzBreaks(k) = i
End If
Next
'if last break was prior to last row, add final break
If horzBreaks(k) < rng.Rows.count Then
k = k + 1
ReDim Preserve horzBreaks(1 To k)
horzBreaks(k) = rng.Rows.count + 1
End If
End Sub

xluser2007
04-20-2008, 01:42 AM
Hi tstav,

I tested your code again. It worked well for most pages, However:


Sometimes page 1 was left out for the watermark for a few worksheets.

Sometimes even when there appear to only be 2 printable pages in "Page break view", the draft stamp was pasted over 10 times below in greyed areas when you enter "Page break View". (this is not a flaw in the macr, I think there may be hidden manual page breaks in some of the pages that your macro is actually picking up).

Also I found that from an end user point of view, seeing too many draft stamps may be a bit frustrating and that it only needs to be centred on Page 1 and Page 2.
Please note, this was only a thought I realised AFTER seeing your brilliant code work through the sheets, not before this whole desire to convert the watermark process into a VBA code came about.
As a result, I took your code and tried to simplify (noobishly of course :yes) and came up with the following (relevant credits are in the comment header):

Sub WatermarkAdd_xluser_modified()

' This is taking the coding of VBAX member tstav (http://www.vbaexpress.com/forum/showthread.php?p=140713#post140713) (http://www.vbaexpress.com/forum/showthread.php?p=140713#post140713%29),
' and modifying it

' Key difference is that the Watermark Picture is placed in the CENTRE of the USEDRANGE
' of each worksheet in the relevant workbook
' It also uses the coding of Andy Pope from an Ozgrid post (http://www.ozgrid.com/forum/showthread.php?t=27237) for
' determining how to paste a picture in a target cell adress (in our case the cell
' address representing half the rows and columns the UsedRange of each worksheet)

Dim wbk As Workbook
Dim sht As Worksheet
Dim vertBreaks() As Long, horzBreaks() As Long, vert As Long, horz As Long
Dim rng As Range

'Application.ScreenUpdating = False
Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy

For Each wbk In Workbooks
'Exclude the workbooks you don't want the watermark to go into
'If wbk.Name <> ThisWorkbook.Name And wbk.Name <> "Draft_watermark_sample.xls" And wbk.Name <> "VBXL_ExtraMenu.xls" Then
If wbk.Name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
'Debug.Print sht.name
sht.Activate

'Get each printable page and center the watermark inside it

Cells(Int(sht.UsedRange.Rows.Count / 2), Int(sht.UsedRange.Columns.Count / 2)).Select
sht.Paste
Next
End If
Next

Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub
this way it places it in the centre of the Usedrange (by taking the integer part of the usedramge.rows.count/2 and same for columns). Note this is not a strict center by I'm not sure how to specify rows 26.5 for example :).

This yields good results when the used range is roughly the size of the page to be printed, but otherwise not well, compared to your code above.

So as such, I was thinking, is it possible to modify your code, such that it will only draft stamp the Centre of page 1 of each worksheet.

So how do you feel on the above tstav, please let me know your thoughts.

Also if anyone else has come across relevant object positioning problems please feel free to join in the fun!

Edit: Bullet pointed for clarity.

mdmackillop
04-20-2008, 04:36 AM
Check if your printer has the abilty to print watermarks. If so, this may be a simpler solution.

xluser2007
04-20-2008, 05:12 AM
Check if your printer has the abilty to print watermarks. If so, this may be a simpler solution.
Yes md, completely agree, though I'm quite sure my work printer doesn't have this facility.

tstav
04-20-2008, 07:49 AM
Hi again,

first thing to mention, is that I agree, too, that all these watermarks tend to attract the attention that is intended for the data on the printed pages (and we never want that to happen). But for the sake of experimenting, I enjoyed doing it.

Now, concerning your test findings of post#15:

I'm quite convinced that the first and second bullet notes, are caused by data in various cells which even though they may have been cleared, are still caught up by the sheet.usedrange, thus resulting in counting the pageBreaks within those wider than desired areas.
This will only be avoided if you delete these empty (but not quite so empty) rows or columns. Check KnowledgeBase entry http://vbaexpress.com/kb/getarticle.php?kb_id=83 by DRJ.

As for the centering of the watermark, I wouldn't rely at all on the count of rows / columns and then devide by two. Rows/columns may be of very different heights and widths and lead us to results way out of being close to the center of the page.
Think of a row containing columns A,B,C (width 30, 30, 30) and columns D,E,F (width 100, 200, 200). The "middle" of the row would be cell number 3.5 (way off target). Same with rows.
On the contrary, taking into account the width and height of the cells (i.e. of the usedrange of the printable page) and of the watermark, would never create any such problem.

In the code you posted, you are using the usedrange of the whole sheet, not of the the first printable page. This might center the watermark on another printable page, and not the first one.

Try also what mdmackillop suggests. Might save you from all this "trouble".

I have customized the code to print only one watermark in the first printable page of each sheet.

If you're still interested, you can try it.

I should say once more that I have really enjoyed this. Thanks for asking anyway...

Best regards, tstav

Sub WatermarkAdd_2()
Dim wbk As Workbook
Dim sht As Worksheet
Dim vertBreak As Long, horzBreak As Long, vert As Long, horz As Long
Dim rng As Range
'Application.ScreenUpdating = False

'Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy

For Each wbk In Workbooks
'Exclude the workbooks you don't want the watermark to go into
If wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
sht.Activate

vertBreak = 0
horzBreak = 0
GetFirstPageBreaks sht, horzBreak, vertBreak

With sht
'Get the first printable page
Set rng = .Range(.Cells(1, 1), .Cells(horzBreak - 1, vertBreak - 1))
'Paste and center the watermark inside it
'60 and 10 are 'safety measures' not to let the tilted watermark
'bleed outside the printable page borders (DesktopPublishing jargon)
.Paste
.Shapes(.Shapes.count).Top = 60 + rng.Top + Abs(rng.Height - .Shapes(.Shapes.count).Height) / 2
.Shapes(.Shapes.count).Left = 10 + rng.Left + Abs(rng.Width - .Shapes(.Shapes.count).Width) / 2
End With
Next
End If
Next
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub
Sub GetFirstPageBreaks(ByVal sht As Worksheet, ByRef horzBreak As Long, ByRef vertBreak As Long)
Dim rng as Range
Dim i As Long
Set rng = sht.UsedRange
'Get the first vertical pageBreak
For i = 2 To rng.Columns.count
If Columns(i).PageBreak = xlPageBreakAutomatic Or Columns(i).PageBreak = xlPageBreakManual Then
vertBreak = i
Exit For
End If
Next
'If no vertBreak found, add one as last pageBreak
If vertBreak = 0 Then vertBreak = rng.Columns.count + 1
'Get the first horizontal pageBreak
For i = 2 To rng.Rows.count
If Rows(i).PageBreak = xlPageBreakAutomatic Or Rows(i).PageBreak = xlPageBreakManual Then
horzBreak = i
Exit For
End If
Next
'If no horzBreak found, add one as last pageBreak
If horzBreak = 0 Then horzBreak = rng.Rows.count + 1
End Sub
Sub WaterMarkDelete()
Dim wbk As Workbook
Dim sht As Worksheet
Dim i As Integer
On Error Resume Next
For Each wbk In Workbooks '<-- all open workbooks
'Exclude the workbooks you want to retain the watermark
If wbk.name <> "Draft_watermark_sample.xls" Then
For Each sht In wbk.Worksheets
For i = sht.Shapes.count To 1 Step -1
sht.Shapes(i).Delete
Next
Next
End If
Next
End Sub

lucas
04-20-2008, 08:20 AM
A possible alternative:
add a background when it loads which makes it easy to link a lot of files to one background that says DRAFT. Then use code to make it print the background.

you must set a print area.....might be smart to do that with code too.

The picture is a rough one that I just threw together to get this working. I'm sure it can be fine tuned to fit the page better.....

lucas
04-20-2008, 08:59 AM
This works without any of the workbook events....just the macro:
Option Explicit
Sub PrintBackground()
Dim rngPrint As Range
Dim shp As Shape
ActiveSheet.SetBackgroundPicture ThisWorkbook.Path & ("\image1.jpg")
On Error GoTo Waserror

Set rngPrint = Range(ActiveSheet.PageSetup.PrintArea)
Range("a1").Select

ActiveWindow.DisplayHeadings = False

With rngPrint
.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With .Parent
.Paste Destination:=rngPrint
Set shp = .Shapes(Sheet1.Shapes.Count)
.Parent.Windows(1).SelectedSheets.PrintPreview
shp.Delete
End With
End With

ActiveWindow.DisplayHeadings = True
ActiveSheet.SetBackgroundPicture ("")
Exit Sub
Waserror:
MsgBox ("An error has occurred." & vbCr & vbCr & " Make Sure you have a print area selected and try again.")
ActiveWindow.DisplayHeadings = True
End Sub

xluser2007
04-20-2008, 07:45 PM
Hi tstav and lucas!

Thanks both for your contributions.

After consolidating a lot of the points we have discussed earlier, and understanding that this application (at this stage only) will be used on a certain types of workbooks, for my purposes at least, I have reached the following "comprimise" code.

Option Explicit

Sub WatermarkAdd_xluser_modified_version2()

' This is taking the coding of VBAX member tstav (http://www.vbaexpress.com/forum/showthread.php?p=140713#post140713) (http://www.vbaexpress.com/forum/showthread.php?p=140713#post140713%29),
' and modifying it

' Key difference is that the Watermark Picture is placed in the center of the UsedRange
' of each worksheet in the relevant workbook
' It uses the coding of Andy Pope from an Ozgrid post (http://www.ozgrid.com/forum/showthread.php?t=27237) for
' determining how to paste a picture in a target cell adress (in our case the cell
' address representing half the rows and columns the UsedRange of each worksheet)

Dim wbk As Workbook
Dim sht As Worksheet
Dim vertBreaks() As Long, horzBreaks() As Long, vert As Long, horz As Long
Dim rng As Range

'Application.ScreenUpdating = False
Workbooks.Open "C:\Draft_watermark_sample.xls" '<-- Supply path (or comment out if already open)
Workbooks("Draft_watermark_sample.xls").Worksheets(1).Shapes("Draft_Watermark").Copy

For Each wbk In Workbooks
'Exclude the workbooks you don't want the watermark to go into
'If wbk.Name <> ThisWorkbook.Name And wbk.Name <> "Draft_watermark_sample.xls" And wbk.Name <> "VBXL_ExtraMenu.xls" Then
If wbk.Name <> "Draft_watermark_sample.xls" Then

wbk.Sheets(1).Activate

'Get each printable page and center the watermark inside it

Range("I46").Select
Sheets(1).Paste

End If
Next

Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub

This way the watermark is effectively pasted on the first worksheet of each workbook and in Cell ("I46"), which can, by observation be seen as the "centre" of the first printable page on my relevant workbook worksheet'.

Because this first worksheet is effectively the title page, I can have another short script that activates this page, so that the client that opens the workbook can see the Draft stamp clearly straight-off and proceed through the rest of the workbook, knowing that it is a "draft" spreadsheet (less "visual clutter" for the client with only the one stamp).

This rather "brute force" comprimise of your solution tstav is chosen because the workbooks are fortunately from the same template and thus the centre's can be manually chosen for this exercise.

tstav, I have to say I'm really thankful for your help and committment to this problem. As far as genralising the watermark problem (not a brute force solution as above), I think you've almost nailed it!

(I do find that the calculation of page-breaks takes a really long time though. Not sure if or how it can be made more efficient though. Do you find this is the case as well?)

Out of interest I had another thought/ alternative and experimented as follows:
Save the draft_watermark as a jpeg e.g C:\Draft_watermark.jpg.
Go to the first worksheet in the target workbook
Insert a HEADER with the relevant watermark image, centre it by hitting return 20 or so times.
When in print preview mode, the draft stamp image appears in the background, but not when in live viewing mode, so it doesn't quite work (yet :)).
Is there a way to make this HEADER image seem viewable when in normal or page break mode?You see where I'm headed with this, by getting the header to work, we let Excel determine each Page number and we only have to work out:
how to "centre" it on the corresponding page and;
how to display it when in normal or page-break mode.Something interesting to think about (though this I'm sure has taken up way to much of your time as it is :)). Would really like to hear your thoughts on this approach.

lucas, thank you also for your code. I did try to test it, but I kept getting the message box error.

It looks interesting, you seem to be creating an image of the first page and overlapping it onto the spreadsheet. Could you please guide me through a step-by-step proces of how to et your method to work without error please. I would like to really try it out.

Well, sorry for the essay all, it is a complex problem, many (still possible) solutions so thought I'd get my thoughts out on the forum.

Again want to thank you for your help, I will be marking this thread as Solved (for my purposes), but please add your thoughts to the discussion, I'm sure Bob. mikerickson, md and Aussiebear and othr Guru's will also have some novel ways to attack the problem.

regards

lucas
04-20-2008, 08:56 PM
I wonder if anyone else tried it. I set it up in excel 2003 and you are running 2007....I guess that could be a problem.

I have the following references checked. Make sure you have all of them checked for your version.

tstav
04-21-2008, 04:02 AM
As far as genralising the watermark problem (not a brute force solution as above), I think you've almost nailed it

No offense taken xluser2007,but for the sake of being precise and also informative, could you justify the "almost"?
Because I'm getting neither any errors nor any missing watermarks in all multi-page, multi-sheet workbooks I've tested it on.

xluser2007
04-21-2008, 04:25 AM
Hi tstav,

Firstly, please note, my rather long piece (ahem...rambling), was only to draw more discussion around the topic and consolidate work done so far, not be critical but simply comment on the results of testing and experimentation.

By "almost" I meant that for some workbooks I tested on, the problems of not being printed on the first page for only some worksheets, and also for some sheets printing the stamp in the greyed areas in the "Page break mode" i.e. areas which we by glancing would interpret as not printable pages, still existed.

Maybe this is an issue with the workbooks I am currently using, there is a lot happening in them, and there maybe some hidden margins that the macro is actually picking up (not a flaw in code but some hidden stuff in the workbooks).

Again, maybe the above issues were just specific to my workbooks (I can't post them online for testing as there are confidentiality issues). I hope this clarifies, sorry I can't put up a test workbook and only some comments from my testing.

That is all I meant, just a point by point discussion of issues encountered. And also including the final, rather brute force conversion of the code for my purposes (albeit in the process losing a lot of the elgance and automation that you had generated in your code).

Again, I learnt a lot from this exercise, maybe if others test it and it works, I could see it being a really solid KB item!

As an aside, did you have a chnace to consider my header alternative, is it ever possible to view a header image (i.e. the watermark) in page break mode? I mean, a working solution is now there for my purposes, but as an alternative way of attacking the general problem, this was something I was thinking about.

regards,

tstav
04-21-2008, 05:19 AM
Yes, as we've already said (post#18), there may be stray data in some sheets that create a pageBreak way off where we'd expect it to be. Such sheets would need to be cleaned up.

As for the Header issue, I'm a little hesitant on pasting images on every sheet of the workbook, since that might inflate the size of the file unduely. But I sure haven't tested it to say anything with certainty.

It was nice "working" with you, xluser2007, I'll say that again. I like the way you think, and the way you seem to give your best shot at what you're doing.

tstav