Ajouter un filigranne par code sur word (vba)

Commenter

Contenu du snippet

J'en ai ch... mes grands dieux pour trouver une solution à ce problème. Quand vous faites une macro automatique, elle ne marche pas, elle est bourrée de bug.
J'ai donc décidé de partager mon code.
Ca ajoute un filigranne sur tout le document word.
Ma procédure n'est pas compatible avec celle par défaut de Word.

Source / Exemple : 


Sub Filigranne(Texte As String)
    Dim Section As Section
    Dim Header As HeaderFooter

    Word.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    For Each Section In ActiveDocument.Sections
        For Each Header In Section.Headers
            AddFiligranne Texte, Header, Section
        Next
    Next
    Word.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Private Sub AddFiligranne(Texte As String, Header As HeaderFooter, Section As Section)
    Dim ShapeName As String
    ShapeName = "Filigranne_" & Section.Index & "_" & Header.Index
    Header.Range.Select
    
    'détruit un éventuel filigranne précédent
    On Error Resume Next
    Set Shape = Header.Shapes(ShapeName)
    If Not Shape Is Nothing Then Shape.Delete
    If Texte = "" Then Exit Sub
    
    'ajoute le filigranne (c'est dans l'entete, et ça prend 1x1 point en haut à gauche de la page)
    Set Shape = Word.Selection.HeaderFooter.Shapes.AddTextEffect( _
        Office.MsoPresetTextEffect.msoTextEffect1, _
        Texte, "ARIAL", 1, False, False, _
        0, 0)
    Shape.Select
    'met en forme le filigranne pour prendre toute la page
    With Word.Selection.ShapeRange
        .Name = ShapeName
        .TextEffect.Text = Texte
        .TextEffect.FontName = "Arial"
        .TextEffect.FontSize = 1 'la taille de la police est fixé par le ratio
        .Line.Visible = False
        .Fill.Visible = True
        .Fill.Solid
        .Fill.ForeColor.RGB = WdColor.wdColorRed
        .Fill.Transparency = 0.7
        .Rotation = 305
        .LockAspectRatio = True
        .Height = CentimetersToPoints(3.22)
        .Width = CentimetersToPoints(19.34)
        .WrapFormat.AllowOverlap = True
        .WrapFormat.Side = wdWrapNone
        .WrapFormat.Type = 3
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .RelativeVerticalPosition = wdRelativeHorizontalPositionPage
        .Left = wdShapeCenter
        .Top = wdShapeCenter
    End With
End Sub

Conclusion :


Il faut appeler Filigranne avec le texte à mettre en filigranne
Si vous ne mettez pas de texte, le filigranne est effacé.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Warny)