2
www.ChF-Online.de  

Wasserzeichen hinter den Text legen

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
aktiv aktiv Verschiedenes
 Dateiname ohne Endung
 Dokumentstrukturanzeige
 Fenster anordnen
 Fensterliste
 Fensterliste (II)
 Kalender erstellen
 Kommentarinformationen
 Lesezeichen
 Beliebigen Ordner öffnen
 Position der Einfügemarke
 Seitenanfang/-ende
 Shapes ansprechen
 Sicherheitskopien erstellen
 Word-Startparameter
 Word-Startparameter II
 Startordner "Bild einfügen"
 Tags finden u. bearbeiten
 Tags finden/bearbeiten (II)
 Text2WordArt
 Textbausteine verwenden
 Textmarken (I)
 Textmarken (II)
 Überschrift zu Textmarke
 VBA-Konverter
aktiv  Wasserzeichen
 Zeichen tauschen
 Feld-Arbeiten
 Form-Sachen
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
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 

 Besucher: 0 online  |  0 heute  |  0 diesen Monat  |  2212030 insgesamt | Seitenaufrufe: 4   Letzte Änderung: 24.06.2006 © 2001-18 Christian Freßdorf
  Es gibt mehr Leute, die kapitulieren, also solche, die scheitern.
Henry Ford
 powered by phpCMS and PAX