Hello all

I created a watermark in each sheet. When I run my WatermarkGone macro,
all watermarks and pictures/graphics are removed. But, I want to remove
the watermark only. How can I do that? Please give me some advices.

Here are my Watermark and WatermarkGone code:

Sub WaterMarkerGone()
Dim intSheet As Integer
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim intShape As Integer
Dim totalCount As Integer
Dim totalShapes As Integer

totalCount = ActiveWorkbook.Worksheets.Count
For intSheet = 1 To totalCount
Set wkSheet = ActiveWorkbook.Worksheets(intSheet)
totalShapes = wkSheet.Shapes.Count
Do While totalShapes 0
wkSheet.Shapes(totalShapes).Delete
totalShapes = totalShapes - 1
Loop
Next intSheet
End Sub

Sub Watermark()
Dim wkSheet As Integer
Set myDocument = ActiveWorkbook

For wkSheet = 1 To ActiveWorkbook.Sheets.Count
Set myWatermark = myDocument.Worksheets(wkSheet).Shapes.AddTextEffec t(
_
PresetTextEffect:=msoTextEffect2, _
Text:="Draft", _
FontName:="Arial Black", _
FontSize:=36, _
FontBold:=False, _
FontItalic:=False, _
Left:=318.75, _
Top:=159.75)
With myWatermark
Name = "Dum"
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Fill.Solid
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 22
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With
Next wkSheet
End Sub

Hi Bon,

Try:

'=============
Sub WaterMarkerGone()
Application.ScreenUpdating = False
Dim page As Integer
For page = 1 To Application. _
ExecuteExcel4Macro("GET.DOCUMENT(50)")
On Error Resume Next
ActiveSheet.Shapes("Dum").Select
Selection.Cut
Next page
Application.CutCopyMode = False
End Sub
'<<=============

---
Regards,
Norman


"Bon" wrote in message
oups.com...
Hello all

I created a watermark in each sheet. When I run my WatermarkGone macro,
all watermarks and pictures/graphics are removed. But, I want to remove
the watermark only. How can I do that? Please give me some advices.

Here are my Watermark and WatermarkGone code:

Sub WaterMarkerGone()
Dim intSheet As Integer
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim intShape As Integer
Dim totalCount As Integer
Dim totalShapes As Integer

totalCount = ActiveWorkbook.Worksheets.Count
For intSheet = 1 To totalCount
Set wkSheet = ActiveWorkbook.Worksheets(intSheet)
totalShapes = wkSheet.Shapes.Count
Do While totalShapes 0
wkSheet.Shapes(totalShapes).Delete
totalShapes = totalShapes - 1
Loop
Next intSheet
End Sub

Sub Watermark()
Dim wkSheet As Integer
Set myDocument = ActiveWorkbook

For wkSheet = 1 To ActiveWorkbook.Sheets.Count
Set myWatermark = myDocument.Worksheets(wkSheet).Shapes.AddTextEffec t(
_
PresetTextEffect:=msoTextEffect2, _
Text:="Draft", _
FontName:="Arial Black", _
FontSize:=36, _
FontBold:=False, _
FontItalic:=False, _
Left:=318.75, _
Top:=159.75)
With myWatermark
Name = "Dum"
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Fill.Solid
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 22
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With
Next wkSheet
End Sub

Sub WaterMarkerGone()
Dim intSheet As Int eger
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim intShape As Integer
Dim totalCount As Integer
Dim totalShapes As Integer
totalCount = ActiveWorkbook.Worksheets.Count
For intSheet = 1 To totalCount
Set wkSheet = ActiveWorkbook.Worksheets(intSheet)
totalShapes = wkSheet.Shapes.Count
If TypeName(Selection) = "Rectangle" Then 'New added
Do While totalShapes 0
wkSheet.Shapes(totalShapes).Delete
totalShapes = totalShapes - 1
Loop
End If 'New added
Next intSheet
End Sub

I tried to put IF TypeName(Selection) = "Rectangle" Then 'Remove
watermark. But, the watermark doesn't be removed.

The suggested procedure doesn't remove watermarks in all worksheets as
well. Any other way I can try?

Please give me some suggestions.

Thanks
Bon
Norman Jones 寫�：

Hi Bon,

Try:

'=============
Sub WaterMarkerGone()
Application.ScreenUpdating = False
Dim page As Integer
For page = 1 To Application. _
ExecuteExcel4Macro("GET.DOCUMENT(50)")
On Error Resume Next
ActiveSheet.Shapes("Dum").Select
Selection.Cut
Next page
Application.CutCopyMode = False
End Sub
'<<=============

---
Regards,
Norman


"Bon" wrote in message
oups.com...
Hello all

I created a watermark in each sheet. When I run my WatermarkGone macro,
all watermarks and pictures/graphics are removed. But, I want to remove
the watermark only. How can I do that? Please give me some advices.

Here are my Watermark and WatermarkGone code:

c

Sub Watermark()
Dim wkSheet As Integer
Set myDocument = ActiveWorkbook

For wkSheet = 1 To ActiveWorkbook.Sheets.Count
Set myWatermark = myDocument.Worksheets(wkSheet).Shapes.AddTextEffec t(
_
PresetTextEffect:=msoTextEffect2, _
Text:="Draft", _
FontName:="Arial Black", _
FontSize:=36, _
FontBold:=False, _
FontItalic:=False, _
Left:=318.75, _
Top:=159.75)
With myWatermark
Name = "Dum"
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Fill.Solid
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 22
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With
Next wkSheet
End Sub

Hi Bon,

Try:

Sub WaterMarkerGone()
Dim SH As Worksheet
Dim shp As Shape

Application.ScreenUpdating = False

For Each SH In ActiveWorkbook.Worksheets
For Each shp In SH.Shapes
If shp.Name = "Dum" Then
shp.Delete
End If
Next shp
Next SH

Application.ScreenUpdating = True

End Sub
'<<=============


---
Regards,
Norman


"Bon" wrote in message
oups.com...
Sub WaterMarkerGone()
Dim intSheet As Int eger
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim intShape As Integer
Dim totalCount As Integer
Dim totalShapes As Integer
totalCount = ActiveWorkbook.Worksheets.Count
For intSheet = 1 To totalCount
Set wkSheet = ActiveWorkbook.Worksheets(intSheet)
totalShapes = wkSheet.Shapes.Count
If TypeName(Selection) = "Rectangle" Then 'New added
Do While totalShapes 0
wkSheet.Shapes(totalShapes).Delete
totalShapes = totalShapes - 1
Loop
End If 'New added
Next intSheet
End Sub

I tried to put IF TypeName(Selection) = "Rectangle" Then 'Remove
watermark. But, the watermark doesn't be removed.

The suggested procedure doesn't remove watermarks in all worksheets as
well. Any other way I can try?

Please give me some suggestions.

Thanks
Bon
Norman Jones ??:

Hi Bon,

Try:

'=============
Sub WaterMarkerGone()
Application.ScreenUpdating = False
Dim page As Integer
For page = 1 To Application. _
ExecuteExcel4Macro("GET.DOCUMENT(50)")
On Error Resume Next
ActiveSheet.Shapes("Dum").Select
Selection.Cut
Next page
Application.CutCopyMode = False
End Sub
'<<=============

---
Regards,
Norman


"Bon" wrote in message
oups.com...
Hello all

I created a watermark in each sheet. When I run my WatermarkGone macro,
all watermarks and pictures/graphics are removed. But, I want to remove
the watermark only. How can I do that? Please give me some advices.

Here are my Watermark and WatermarkGone code:

c

Sub Watermark()
Dim wkSheet As Integer
Set myDocument = ActiveWorkbook

For wkSheet = 1 To ActiveWorkbook.Sheets.Count
Set myWatermark = myDocument.Worksheets(wkSheet).Shapes.AddTextEffec t(
_
PresetTextEffect:=msoTextEffect2, _
Text:="Draft", _
FontName:="Arial Black", _
FontSize:=36, _
FontBold:=False, _
FontItalic:=False, _
Left:=318.75, _
Top:=159.75)
With myWatermark
Name = "Dum"
.IncrementRotation -43.46
.Fill.Visible = msoFalse
.Fill.Transparency = 0.5
.Fill.Solid
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 22
.Line.BackColor.RGB = RGB(255, 255, 255)
.ZOrder msoBringToFront
End With
Next wkSheet
End Sub

Hi Norman

The draft watermark can be removed. Thanks for you help.

Thanks
Bon