Aktuelle Seite:
/vba/wasserzeichen.htm
Letzte Änderung: 24.06.2006

Getestet unter Word97Getestet unter Word2000  
Beispiel anzeigen
Makro/Datei speichern
Print

Mit folgendem Makro lässt sich ein Wasserzeichen hinter den Text legen.
Dazu wird in die Kopfzeile gewechselt und ein Text, der über die Eingabebox in Zeile 6 abgefragt wird, als WordArt-Objekt hinter den Text gelegt.
Danach wird das Dokument ausgedruckt (Zeile  42) und anschlieîend das Wasserzeichen wieder gelöscht (Zeile  49). Dieses ist nur eine Möglichkeit, ein Wasserzeichen in das Dokument einzufügen.
Soll das Wasserzeichen erst beim und nur für den Ausdruck erzeugt werden, lässt sich das Makro auch automatisch einbinden, indem der interne Word-Befehl zum Aufruf des Drucker-Dialogsfelds abgefangen und mit dem Makro ersetzt wird.

Wichtig:
Wenn der Word-Befehle ersetzt wird, sollte im Makro auch ein Aufruf des Drucker-Dialogfelds eingebaut werden, bzw. der Ausdruck angestoßen werden. Eine Auflistung diverser Word-Befehle findet sich  hier.

1    Sub Wasserzeichen()
2    ' Makro erstellt am 15.06.99 von Christian Freîdorf 
3    ' 
4    'Wasserzeichen einfügen 
5    Dim sText As String 
6    sText = Inputbox("Bitte den Text eingeben", "Wasserzeichen", "Kopie")
7    If ActiveWindow.View.Type = Not wdPageView Then 
8        ActiveWindow.View.Type = wdPageView 
9    End If 
10   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
       ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
       = wdMasterView Then 
11     ActiveWindow.ActivePane.View.Type = wdPageView 
12   End If 
13   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
14   Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, sText, _
         "Arial Black", 36#, msoFalse, msoFalse, 240.75, 222.75).Select
15   Selection.ShapeRange.Fill.Visible = msoTrue
16   Selection.ShapeRange.Fill.Solid
17   Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
18   Selection.ShapeRange.Fill.Transparency = 0#
19   Selection.ShapeRange.Line.Weight = 0.75
20   Selection.ShapeRange.Line.DashStyle = msoLineSolid
21   Selection.ShapeRange.Line.Style = msoLineSingle
22   Selection.ShapeRange.Line.Transparency = 0#
23   Selection.ShapeRange.Line.Visible = msoTrue
24   Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
25   Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
26   Selection.ShapeRange.LockAspectRatio = msoFalse
27   Selection.ShapeRange.Height = 280
28   Selection.ShapeRange.Width = 320
29   Selection.ShapeRange.Rotation = 330#
30   Selection.ShapeRange.RelativeHorizontalPosition = _
         wdRelativeHorizontalPositionPage 
31   Selection.ShapeRange.RelativeVerticalPosition = _
         wdRelativeVerticalPositionPage 
32   Selection.ShapeRange.Left = CentimetersToPoints(6)
33   Selection.ShapeRange.Top = CentimetersToPoints(7.86)
34   Selection.ShapeRange.LockAnchor = False 
35   Selection.ShapeRange.WrapFormat.Type = wdWrapNone 
36   Selection.ShapeRange.WrapFormat.Side = wdWrapBoth 
37   Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
38   Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
39   Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
40   Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
41   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
42   'Ausdruck für Kopie über Durckerauswahlmenü 
43   With Dialogs(wdDialogFilePrint)
44       .Show
45   End With 
46   'Ausdruck der Kopie über DruckenSymbol 
47   'Application.PrintOut 
48   ' 
49   'Wasserzeichen löschen 
50   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
51   Selection.HeaderFooter.Shapes.SelectAll
52   Selection.ShapeRange.Delete
53   Selection.ShapeRange.Visible = msoFalse
54   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
55   End Sub 

 www.chf-online.de/vba/wasserzeichen.htm © 2001-11 Christian Freßdorf (Zaphod-Systems)