Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Wasserzeichen per Makro im Druck

449 views
Skip to first unread message

Torsten Aulhorn

unread,
Apr 9, 2002, 11:14:38 AM4/9/02
to
Hallo NG,

vor einigen Jahren hatte ich in Word 97 mal ein Makro, das folgende Funktion
hatte:

Beim Klick auf eine (extra) Schaltfläche wurde das aktuelle Dokument in der
Form ausgedruckt, dass es einmal als "Original" gedruckt wurde (ohne
irgendwelche Veränderungen) und dann ein- oder mehrmals mit einem
Wasserzeichen "KOPIE" (oder ähnlich). Das Dokument selbst blieb dabei
unverändert.
Das Ganze war absolut genial, wenn man bspw. Rechnungen ausgedruckt hat -
das lästige Markieren der Kopien entfiel.
Leider habe ich dieses Makro nicht mehr, vielleicht würde es auch unter Word
2000 gar nicht mehr laufen. Eine Suche in diversen Foren, Webseiten und
Newsgroups blieb ohne Erfolg. Da sich meine Kenntnisse im Bereich Makros
darauf beschränken, wie die Dinger eingebunden werden, wäre ich Tips und
Hinweise, wo man sowas findet, sehr dankbar.
Unter Umständen gibt es hier ja auch jemand, der sowas "mal eben" schreibt
???

Wie auch immer - vielen Dank für Eure Hilfe im Voraus.

Gruss
Torsten

Torsten Aulhorn

unread,
Apr 26, 2002, 4:38:54 AM4/26/02
to
Halloooooooooo,

gibts es denn hier niemanden, der mir helfen kann ??????

Viele Grüsse
Torsten


"Torsten Aulhorn" <t...@caledo.de> schrieb im Newsbeitrag
news:OTDmZk93BHA.2144@tkmsftngp07...

Lutz Gentkow

unread,
Apr 26, 2002, 5:17:24 AM4/26/02
to
Hallo Torsten,

schau Dir mal FinePrint an, das kann mit Wasserzeichen umgehen:
http://www.context-gmbh.de

Viele Grüße vom Niederrhein

Lutz

Christian Freßdorf

unread,
Apr 26, 2002, 6:03:35 AM4/26/02
to
Hallo Torsten,

> gibts es denn hier niemanden, der mir helfen kann ??????

http://groups.google.com/groups?hl=de&group=microsoft.public.de.word.vba
ist auch Dein Freund.

Ansonsten verwende folgendes Makro:

Option Explicit

Sub Wasserzeichen()
'
' Wasserzeichen Makro
' Makro erstellt am 15.06.99 von Christian Freßdorf
'
' Original drucken
Application.PrintOut

'Wasserzeichen einfügen
Dim sText As String
sText = Inputbox("Bitte den Wasserzeichentext eingeben",
"Wasserzeichen", "Kopie")
If ActiveWindow.View.Type = Not wdPageView Then
ActiveWindow.View.Type = wdPageView
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, sText, _
"Arial Black", 36#, msoFalse, msoFalse, 240.75, 222.75).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 280
Selection.ShapeRange.Width = 320
Selection.ShapeRange.Rotation = 330#
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
Selection.ShapeRange.Left = CentimetersToPoints(6)
Selection.ShapeRange.Top = CentimetersToPoints(7.86)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.WrapFormat.Type = wdWrapNone
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight =
CentimetersToPoints(0.32)

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'Ausdruck für Kopie über Durckerauswahlmenü
'With Dialogs(wdDialogFilePrint)
'.Show
'End With
'Ausdruck der Kopie über DruckenSymbol
Application.PrintOut


'Wasserzeichen löschen
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.SelectAll
Selection.ShapeRange.Delete
'Selection.ShapeRange.Visible = msoFalse
' Ansicht wechseln
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

--

Gruß
Christian

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Wenn Ihr Fragen stellt, gebt bitte auch Rückmeldungen
Anworten bitte nur in diese NG und im Original-Thread
Ich beantworte generell keine Fragen per E-Mail!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

0 new messages