"Confidential"

[GVBMT]

I want to print my excel book and want to add the word "confidential" (maybe a picture) filling each page of the print; of course the word should be printed transparant.

GVBMT

 

[genomon]

This should help:

http://articles.techrepublic.com.com/5100-10878_11-5029907.html

Cogito eggo sum – I think, therefore I am a waffle.

 

[Gavona]

I can't recall where I got this from. I have not well tested it but it has worked for me. Just be wary that the RemoveStamps macro deletes ALL shapes on the active sheet.

Attribute VB_Name = "RubberStamp"
Option Explicit
Sub RubberStamp()
Dim intShapes As Integer
Dim x As Integer
Dim dblShapesHeight As Double
Dim dblRangeHeight As Double
Dim strStamp As String
Dim rngStart As Range
Dim rngEnd As Range
Dim dblPageWidth As Double
Dim dblShapesIndent As Double
Dim blnPagesDone As Boolean

strStamp = InputBox("Enter the text that you" _
   & " want used for your stamp", _
   "Enter Stamp Text")

dblRangeHeight = ActiveSheet.UsedRange.Height
Set rngStart = Range("A1")
x = 1
blnPagesDone = False

On Error GoTo ErrorHandling

Do Until blnPagesDone = True
    Set rngEnd = _
        ActiveSheet.VPageBreaks(x).Location
    dblPageWidth = Range(rngStart, _
        rngEnd.Offset(0, -1)).Width
    
    If dblPageWidth < _
        Application.InchesToPoints(4) Then
            dblPageWidth = _
            Application.InchesToPoints(4)
    End If
    Set rngStart = rngEnd
    x = x + 1
    dblShapesHeight = 0
    
    Application.Wait Now + TimeValue("00:00:01")
    
    Do While dblRangeHeight > dblShapesHeight
        intShapes = intShapes + 1
        
        With ActiveSheet.Shapes. _
            AddTextEffect(msoTextEffect2, _
                strStamp, "Arial Black" _
                    , 36, msoFalse, msoFalse, _
                    0 + dblShapesIndent, 0 + _
                    dblShapesHeight)
       
            .Name = "STAMP_" & intShapes
            .Height = _
                Application.InchesToPoints(2)
            .Placement = xlFreeFloating
            .Width = dblPageWidth
            .Fill.Transparency = 0.75
            .Line.Weight = 0.25
            .Fill.ForeColor.SchemeColor = 44
            dblShapesHeight = dblShapesHeight + _
                .Height
        End With
        
    Loop
    
    dblShapesIndent = dblShapesIndent + _
        dblPageWidth
    
Loop
Set rngStart = Nothing
Set rngEnd = Nothing
Exit Sub

ErrorHandling:
Select Case Err
    Case 9
        Set rngEnd = ActiveSheet.UsedRange. _
            SpecialCells(xlCellTypeLastCell). _
            Offset(0, 1)
        blnPagesDone = True
        Resume Next
    Case 1004
        Exit Sub
    Case Else
        MsgBox Err & ": " & Err.Description
End Select
End Sub

Sub RemoveStamps()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    With shp
        If Left(.Name, 5) = "STAMP" Then
            .Delete
        End If
    End With
Next
End Sub

Gavin

 

[combo]

To proceed without VBA:
1) design a wordart in powerpoint slide, portrait orientation,
2) save slide in 'wmf' format,
3) assign picture to center section of the header or footer of worksheet,
4) adjust image if necessary (watermark, b/w, etc.),
5) in print preview display margins, adjust header's (footer's) margin to center image vertically.

The picture is printed behind worksheet's contents.

combo