 |
|
 |
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
|
 |
