Quelle solution pour obtenir une version originale d'un document plus deux duplicatas (duplicata imprimé en filigrane) ?
- Détails
- Catégorie parente: Faq Word
- Catégorie : VBA solutions
- Mis à jour le dimanche 23 octobre 2011 00:54
- Affichages : 3035
Il n'est pas nécessaire d'avoir plusieurs versions du fichier. Il suffit simplement de prévoir le filigrane,
et d'utiliser la macro suivante pour l'impression.
Cette macro va masquer le filigrane pour une première impresssion.
Cette macro est inspirée de celle de Geo qui permet d'imprimer sans le pied de page.
Sub duplicata()
' macro écrite par marina
Options.PrintHiddenText = False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'met l'en-tête en format masqué
With Selection.Font
.Hidden = True
End With
'imprime le fichier sans en-tête
ActiveDocument.PrintOut
'Remettre l'entête en "mode visible"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
With Selection.Font
.Hidden = False
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveDocument.PrintOut copies:=2
End Sub
C'est une solution simple, car l'utilisateur peut modifier le filigrane comme il le voudra, la macro restera toujours valable. Par contre, si le document contient un "véritable" en-tête en plus du filigrane, cette solution ne convient pas car l'entête serait également supprimé sur le document original.
Il faudrait donc créer une macro qui insère le filigrane et le retire. Seulement, ce n'est pas si simple car le filigrane n'est rien d'autre qu'une image à construire, avec toutes ses propriétés de couleur, d'orientation, de transparence, de placement, etc. Et si vous souhaitez modifier ce filigrane, ce serait compliqué.
La solution serait donc de créer soi-même une insertion automatique d'un filigrane, et la macro irait chercher simplement cette insertion automatique. Donc,
- Créez votre filigrane
- Passez en affichage d'en-tête et sélectionnez le filigrane
- Créez l'insertion automatique ou le Quickpart ; sélectionnez l'image filigrane puis :
- Word 2000-2003
- Appuyez sur Alt+F3, nommez votre Insertion "Duplicata" et OK
- Word 2007-2010
-
- Onglet Mise en page, groupe Arrière-plan de page, bouton Filigrane => Enregistrez la sélection dans la galerie des filigranes
- Nommez-le "Duplicata" et OK
- Vous pouvez sortir de l'en-tête
Voici donc la macro qui imprimera le document en un exemplaire sans filigrane puis en deux exemplaires avec filigrane :
- Word 2000-2003
-
Sub duplicatas2()
'macro écrite par marina
'Première impression
ActiveDocument PrintOut
'Insertion du filigrane
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
NormalTemplate.AutoTextEntries("duplicata").Insert _
Where:=Selection.Range, RichText:=True
'Impression des pages suivantes (on peut modifier le nombre de copies)
ActiveDocument.PrintOut copies:=2
'suppression du filigrane
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For Each dessin In Selection.HeaderFooter.Shapes
If Left(dessin.Name, 9) = "PowerPlus" Then dessin.Delete
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub - Word 2007-2010
-
Vous devrez mettre le chemin complet du modèle building blocks qui contient les quickparts, à moins de mettre le quickpart dans le modèle Normal.dotm ou le modèle du document
Sub duplicatas2()
'macro écrite par marina
'Première impression
ActiveDocument PrintOut
'Insertion du filigrane
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'\\\\\Modifier ici le chemin complet du modèle Building Blocks
Application.Templates( _
"C:\Users\nom_user\AppData\Roaming\Microsoft\Document Building Blocks\1036\14\Building Blocks.dotx" _
).BuildingBlockEntries("DUPLICATA").Insert Where:=Selection.Range, _
RichText:=True
'Impression des pages suivantes (on peut modifier le nombre de copies)
ActiveDocument.PrintOut copies:=2
'suppression du filigrane
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For Each dessin In Selection.HeaderFooter.Shapes
If Left(dessin.Name, 9) = "PowerPlus" Then dessin.Delete
Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
