AJOUTER UN FILIGRANNE PAR CODE SUR WORD (VBA)
Xav88
Messages postés
178
Date d'inscription
mercredi 8 octobre 2003
Statut
Membre
Dernière intervention
25 septembre 2008
-
22 févr. 2004 à 13:03
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 - 27 juin 2008 à 08:47
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 - 27 juin 2008 à 08:47
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/19482-ajouter-un-filigranne-par-code-sur-word-vba
https://codes-sources.commentcamarche.net/source/19482-ajouter-un-filigranne-par-code-sur-word-vba
27 juin 2008 à 08:47
L'enregistreur de macro fonctionne correctement au moins avec Word2003 : ce qui donne ce code :
=
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 27/06/2008 par Us
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject1, _
"BROUILLON", "Times New Roman", 1, False, False, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject1"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
Selection.ShapeRange.Line.Visible = False
Selection.ShapeRange.Fill.Visible = True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(4.1)
Selection.ShapeRange.Width = CentimetersToPoints(18.46)
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left = wdShapeCenter
Selection.ShapeRange.Top = wdShapeCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
=
Attention toutefois, il faut partir d'un document vierge (ne supporte pas le double filigramme)...
Amicalement,
Us.
22 févr. 2004 à 13:03
Rien à redire....
Xav.