I will first write the code then explain the problem

ThisWorkbook Part:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
End If
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
StampEveryPage
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
End If
End Sub

Module Part:

Option Explicit

'Adds Word Art to Sheet
Sub AddWordArt(i As Long)
Dim celTop As Long

celTop = ActiveCell.Top
ActiveSheet.Shapes.AddTextEffect(msoTextEffect2, "Uncontrolled Copy" &
Chr(13) & "" & Chr(10) & "Cannot Be Proceded", "Arial Black", 4#, msoFalse,
msoFalse, 0, celTop).Select
'WordArt added
Selection.Name = "Kontrol" & i
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0.8
Selection.ShapeRange.Line.Visible = msoFalse
'WordArt made transparent
End Sub

'This find number of pages through number of pagebreaks and adds each page
the word art
Sub StampEveryPage()
Dim hBreak As Long, i As Long, numPages As Long, startRow As Long, HB As
HPageBreaks
Application.ScreenUpdating = False
Set HB = ActiveSheet.HPageBreaks
numPages = HB.Count + 1
'Number of Pages is one more than number of PageBreaks
startRow = 1
If numPages 1 Then
For i = 1 To numPages - 1
hBreak = HB.Item(i).Location.Row <-------- I usually get here
"Error : 9, Subscript out of range" error. But not always
'Page break located
Cells(Int((hBreak + startRow) / 2), 3).Select
'Find the middle of the page
AddWordArt i
'wordArt get added to that page
startRow = hBreak
Next i
End If

'When the last page come
Cells(hBreak + 15, 3).Select
AddWordArt numPages
Application.ScreenUpdating = True

End Sub

'deletes all added WordArts from sheet
Sub UnStampEveryPage()
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Kontrol" Then shp.Delete
Next shp
Application.ScreenUpdating = True
End Sub

'Checks if the Workbook has a Custom Document Property named "ISO"
Function PropExis() As Boolean
Dim objdocProp1 As DocumentProperty
For Each objdocProp1 In Application.ActiveWorkbook.CustomDocumentPropertie s
If "ISO" = objdocProp1.Name Then
PropExis = True
Exit Function
End If
Next
PropExis = False
End Function

'If the workbook has "ISO" Property, returns the value of property
Function PropValue() As Boolean
If PropExis = True Then
PropValue = Application.ActiveWorkbook.CustomDocumentPropertie s("ISO").Value
End If
End Function


I saved this as an Add-in and plan to use it with every Excel Workbook. My
first problem is with StampEveryPage Sub. It seems to work unstable. It
works sometimes but most of the time It gives error number 9, sometimes It
adds wordart to some pages and skip the others etc.

My second problem is that none of the events in my Add-in seems to work. I'm
sure that the Add-in is installed and loaded. But somehow they don't happen
when I trigger them (ex. When I print the workbook). One of my friends told
me I need to reference this Add-in to every Workbook which I work, but he
didn't know how to do it. Can anyone help me pls.

Thanks a lot,
Burak

2nd problem - you need it instantiate application level events to trap for
all the workbooks

http://www.cpearson.com/excel/AppEvent.htm
Chip Pearson's page on Application Level events.

1st problem

Trap the error

Sub StampEveryPage()
Dim hBreak As Long, i As Long, numPages As Long, startRow As Long, HB As
HPageBreaks
Application.ScreenUpdating = False
Set HB = ActiveSheet.HPageBreaks
numPages = HB.Count + 1
'Number of Pages is one more than number of PageBreaks
startRow = 1
If numPages 1 Then
On Error Resume next
For i = 1 To numPages - 1
hBreak = HB.Item(i).Location.Row
if err = 0 then
'Page break located
Cells(Int((hBreak + startRow) / 2), 3).Select
'Find the middle of the page
AddWordArt i
'wordArt get added to that page
startRow = hBreak
else
err.clear
end if
Next i
End If





"Burak" wrote in message
...
I will first write the code then explain the problem

ThisWorkbook Part:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
End If
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
StampEveryPage
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
If PropExis = True And PropValue = True Then
UnStampEveryPage
End If
End Sub

Module Part:

Option Explicit

'Adds Word Art to Sheet
Sub AddWordArt(i As Long)
Dim celTop As Long

celTop = ActiveCell.Top
ActiveSheet.Shapes.AddTextEffect(msoTextEffect2, "Uncontrolled Copy" &
Chr(13) & "" & Chr(10) & "Cannot Be Proceded", "Arial Black", 4#,
msoFalse,
msoFalse, 0, celTop).Select
'WordArt added
Selection.Name = "Kontrol" & i
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Fill.Transparency = 0.8
Selection.ShapeRange.Line.Visible = msoFalse
'WordArt made transparent
End Sub

'This find number of pages through number of pagebreaks and adds each page
the word art
Sub StampEveryPage()
Dim hBreak As Long, i As Long, numPages As Long, startRow As Long, HB As
HPageBreaks
Application.ScreenUpdating = False
Set HB = ActiveSheet.HPageBreaks
numPages = HB.Count + 1
'Number of Pages is one more than number of PageBreaks
startRow = 1
If numPages 1 Then
For i = 1 To numPages - 1
hBreak = HB.Item(i).Location.Row <-------- I usually get here
"Error : 9, Subscript out of range" error. But not always
'Page break located
Cells(Int((hBreak + startRow) / 2), 3).Select
'Find the middle of the page
AddWordArt i
'wordArt get added to that page
startRow = hBreak
Next i
End If

'When the last page come
Cells(hBreak + 15, 3).Select
AddWordArt numPages
Application.ScreenUpdating = True

End Sub

'deletes all added WordArts from sheet
Sub UnStampEveryPage()
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Kontrol" Then shp.Delete
Next shp
Application.ScreenUpdating = True
End Sub

'Checks if the Workbook has a Custom Document Property named "ISO"
Function PropExis() As Boolean
Dim objdocProp1 As DocumentProperty
For Each objdocProp1 In
Application.ActiveWorkbook.CustomDocumentPropertie s
If "ISO" = objdocProp1.Name Then
PropExis = True
Exit Function
End If
Next
PropExis = False
End Function

'If the workbook has "ISO" Property, returns the value of property
Function PropValue() As Boolean
If PropExis = True Then
PropValue =
Application.ActiveWorkbook.CustomDocumentPropertie s("ISO").Value
End If
End Function


I saved this as an Add-in and plan to use it with every Excel Workbook. My
first problem is with StampEveryPage Sub. It seems to work unstable. It
works sometimes but most of the time It gives error number 9, sometimes It
adds wordart to some pages and skip the others etc.

My second problem is that none of the events in my Add-in seems to work.
I'm
sure that the Add-in is installed and loaded. But somehow they don't
happen
when I trigger them (ex. When I print the workbook). One of my friends
told
me I need to reference this Add-in to every Workbook which I work, but he
didn't know how to do it. Can anyone help me pls.

Thanks a lot,
Burak