Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

piloter word2007 pour inserer un filigrane depuis excel

5 réponses
Avatar
Alfred WALLACE
Bonjour,
lorsque je lance l'enregistreur de macro de word, pour inserer
dans la page blance un filigrane ("mise en page" + "filigrane" +
"filigrane perso")
j'obtiens le code ci-apr=E8s.
En fait, mon filigrane personnalis=E9 (ici "monsieur toto") est
dans une liste de ma feuille excel.

J'aimerai donc, ouvrir word, et pour chaque noms
de la feuille (de [A2:A50] par exemple) :
- cr=E9er la page vierge word et y inserer le filigrane de Ax
- exporter en PDF la feuille


Merci pour votre aide.

Jos=E9




'************
Sub Macro3()
'
' Macro3 Macro
'
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView =3D wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( _
PowerPlusWaterMarkObject2082223235, "monsieur toto", "Times
New Roman", 1, _
False, False, 0, 0).Select
Selection.ShapeRange.Name =3D "PowerPlusWaterMarkObject2082223235"
Selection.ShapeRange.TextEffect.NormalizedHeight =3D False
Selection.ShapeRange.Line.Visible =3D False
Selection.ShapeRange.Fill.Visible =3D True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB =3D RVB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency =3D 0.5
Selection.ShapeRange.Rotation =3D 315
Selection.ShapeRange.LockAspectRatio =3D True
Selection.ShapeRange.Height =3D CentimetersToPoints(3.47)
Selection.ShapeRange.Width =3D CentimetersToPoints(19.09)
Selection.ShapeRange.WrapFormat.AllowOverlap =3D True
Selection.ShapeRange.WrapFormat.Side =3D wdWrapNone
Selection.ShapeRange.WrapFormat.Type =3D 3
Selection.ShapeRange.RelativeHorizontalPosition =3D _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.RelativeVerticalPosition =3D _
wdRelativeVerticalPositionMargin
Selection.ShapeRange.Left =3D wdShapeCenter
Selection.ShapeRange.Top =3D wdShapeCenter
ActiveWindow.ActivePane.View.SeekView =3D wdSeekMainDocument
ActiveDocument.ExportAsFixedFormat OutputFileName:=3D _
"C:\Users\d40442\Documents\LiberKey\Apps\PDFTKBuilder\App
\PDFTKBuilder\monsieur toto.pdf" _
, ExportFormat:=3DwdExportFormatPDF, OpenAfterExport:=3DTrue,
OptimizeFor:=3D _
wdExportOptimizeForPrint, Range:=3DwdExportAllDocument, From:=3D1,
To:=3D1, _
Item:=3DwdExportDocumentContent, IncludeDocProps:=3DTrue,
KeepIRM:=3DTrue, _
CreateBookmarks:=3DwdExportCreateNoBookmarks,
DocStructureTags:=3DTrue, _
BitmapMissingFonts:=3DTrue, UseISO19005_1:=3DFalse
End Sub

'************

5 réponses

Avatar
Gloops
Alfred WALLACE a écrit, le 09/06/2011 12:06 :
Bonjour,
lorsque je lance l'enregistreur de macro de word, pour inserer
dans la page blance un filigrane ("mise en page" + "filigrane" +
"filigrane perso")
j'obtiens le code ci-après.
En fait, mon filigrane personnalisé (ici "monsieur toto") est
dans une liste de ma feuille excel.

J'aimerai donc, ouvrir word, et pour chaque noms
de la feuille (de [A2:A50] par exemple) :
- créer la page vierge word et y inserer le filigrane de Ax
- exporter en PDF la feuille


Merci pour votre aide.

José




'************
Sub Macro3()
'
' Macro3 Macro
'
'
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect( _
PowerPlusWaterMarkObject2082223235, "monsieur toto", "Times
New Roman", 1, _
False, False, 0, 0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject2082223235"
Selection.ShapeRange.TextEffect.NormalizedHeight = False
Selection.ShapeRange.Line.Visible = False
Selection.ShapeRange.Fill.Visible = True
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RVB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(3.47)
Selection.ShapeRange.Width = CentimetersToPoints(19.09)
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
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
"C:Usersd40442DocumentsLiberKeyAppsPDFTKBuilderApp
PDFTKBuildermonsieur toto.pdf" _
, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True,
OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:= 1,
To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True,
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks,
DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:úlse
End Sub

'************




Bonjour,

J'imagine que cette question est rendue obsolète par la solution trouvé e
avec PDFtK ?
Avatar
Alfred WALLACE
Bonjour Gloops,
ben non, pas du tout, cette question est complémentaire en fait,
j'explique :

la commande dos que je dois faire executer (en rapport, donc avec
l'autre post)
est sous cette forme-ci :

"pdftk document.pdf stamp toto.pdf output resultat-toto.pdf "

en fait, pdftk "appose" dans document.pdf un filigrane (stamp) nommé
"toto.pdf" dans
cet exemple, et génére un nouveau document pdf "resultat-toto.pdf".

dans ce poste ci (celui-là même) je souhaite generer le "toto.pdf".

pour ce faire, je fais, dans un document vierge un filigrane en
enregistrent (dans word donc)
la macro suivante :

Sub Macro5()
'
' Macro5 Macro DANS L'ENREGISTREUR WORD
'
'
Documents.Add Template:="Normal", NewTemplate:úlse,
DocumentType:=0
ActiveDocument.Sections(1).Range.Select
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject,
_
"MON-FILIGRANE", "Times New Roman", 1, False, False, 0,
0).Select
Selection.ShapeRange.Name = "PowerPlusWaterMarkObject"
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) '<<= =
ATTENTION
' ICI L'ENREGISTREUR MACRO DE WORD ECRIT RVB(192, 192, 192) CE QUI
GENERE UNE ERREUR
' A L'EXECUTION : FAUT CORRIGER A LA MAIN.
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Rotation = 315
Selection.ShapeRange.LockAspectRatio = True
Selection.ShapeRange.Height = CentimetersToPoints(3.22)
Selection.ShapeRange.Width = CentimetersToPoints(19.34)
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
lorsque j'execute cette macro DANS WORD elle fonctionne très bien
(après avoir mis RGB à la place
de RVB).


maintenant j'essaye VIA EXCEL d'executer cette macro, donc de piloter
word
à travers une macro excel, çà donne ceci, mais çà generer une feu ille
blanche
sans provoquer d'erreurs :

Sub envoyerdonneesexcelversword()
Dim Wd As Object, Dc As Object, Fichier As String

On Error Resume Next
'Vérifie si l'application est déjà ouvert ....
Set Wd = GetObject(, "word.application")
'Si pas ouvert, cela génère une erreur...
'Raison de la présence de On error resume next

If Err <> 0 Then
Err = 0
'Création d'une nouvelle instance de Word
Set Wd = CreateObject("word.application")
Set Dc = Wd.Documents.new
Wd.Visible = True
'Reste de la macro
'Traitement du fichier word

'CETTE MACRO EST TIREE DE L'ENREGISTREUR DE MACRO DE WORD
'j'ai seulement rajouter le "Wd." devant chaque appel pour (je
pensais) bien faire référence
'à l'objet word crée plus haut.
Wd.Documents.Add Template:="Normal", NewTemplate:úlse,
DocumentType:=0
Wd.ActiveDocument.Select 'Sections(1).Range.Select
Wd.ActiveWindow.ActivePane.View.SeekView = Wd.wdSeekCurrentPageHeader
Wd.Selection.HeaderFooter.Shapes.AddTextEffect(PowerPlusWaterMarkObject,
"José SISA-6A", "Times New Roman", 1, False, False, 0, 0).Select
Wd.Selection.ShapeRange.Name = "PowerPlusWaterMarkObject"
Wd.Selection.ShapeRange.TextEffect.NormalizedHeight = False
Wd.Selection.ShapeRange.Line.Visible = False
Wd.Selection.ShapeRange.Fill.Visible = True
Wd.Selection.ShapeRange.Fill.Solid
Wd.Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
Wd.Selection.ShapeRange.Fill.Transparency = 0.5
Wd.Selection.ShapeRange.Rotation = 315
Wd.Selection.ShapeRange.LockAspectRatio = True
Wd.Selection.ShapeRange.Height = Wd.CentimetersToPoints(3.22)
Wd.Selection.ShapeRange.Width = Wd.CentimetersToPoints(19.34)
Wd.Selection.ShapeRange.WrapFormat.AllowOverlap = True
Wd.Selection.ShapeRange.WrapFormat.Side = wdWrapNone
Wd.Selection.ShapeRange.WrapFormat.Type = 3
Wd.Selection.ShapeRange.RelativeHorizontalPosition =
Wd.wdRelativeVerticalPositionMargin
Wd.Selection.ShapeRange.RelativeVerticalPosition =
Wd.wdRelativeVerticalPositionMargin
Wd.Selection.ShapeRange.Left = Wd.wdShapeCenter
Wd.Selection.ShapeRange.Top = Wd.wdShapeCenter
Wd.ActiveWindow.ActivePane.View.SeekView = Wd.wdSeekMainDocument


Set Wd = Nothing: Set Dc = Nothing

'Word est ouvert ... on continue la procédure
Else
'Boucle qui vérifie si le fichier est déjà ouvert
For Each Dc In Wd.Documents
If Dc.FullName = Fichier Then
MsgBox "Document est déjà ouvert."
Set Wd = Nothing: Set Dc = Nothing
Exit Sub
End If
Next
'Si pas document ouvert ... on continue...
Wd.Documents.Open (Fichier)
Wd.Visible = True
'Reste de Ta macro
'Traitement du fichier word

Set Wd = Nothing: Set Dc = Nothing
End If
End Sub


Voilà, le résultat, est une belle page blanche dans word ...
bon, deja je n'ai aucune érreur, mais, le but est quand
même de faire fonctionner la chose
d'autant que le filigrane CHANGE selon le contenu de
chaque cellules de ma feuille excel.


Voilà j'espère pas avoir été trop "brouillon" dans mes explications .

Merci pour vos aides et conseils.

José




On 10 juin, 22:14, Gloops wrote:
Alfred WALLACE a écrit, le 09/06/2011 12:06 :









> Bonjour,
> lorsque je lance l'enregistreur de macro de word, pour inserer
> dans la page blance un filigrane ("mise en page" + "filigrane" +
> "filigrane perso")
> j'obtiens le code ci-après.
> En fait, mon filigrane personnalisé (ici "monsieur toto") est
> dans une liste de ma feuille excel.

> J'aimerai donc, ouvrir word, et pour chaque noms
> de la feuille (de [A2:A50] par exemple) :
> - créer la page vierge word et y inserer le filigrane de Ax
> - exporter en PDF la feuille

> Merci pour votre aide.

> José

> '************
> Sub Macro3()
> '
> ' Macro3 Macro
> '
> '
>      ActiveDocument.Sections(1).Range.Select
>      ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageH eader
>      Selection.HeaderFooter.Shapes.AddTextEffect( _
>          PowerPlusWaterMarkObject2082223235, "monsieur toto", "Times
> New Roman", 1, _
>          False, False, 0, 0).Select
>      Selection.ShapeRange.Name = "PowerPlusWaterMarkObject20822 23235"
>      Selection.ShapeRange.TextEffect.NormalizedHeight = False
>      Selection.ShapeRange.Line.Visible = False
>      Selection.ShapeRange.Fill.Visible = True
>      Selection.ShapeRange.Fill.Solid
>      Selection.ShapeRange.Fill.ForeColor.RGB = RVB(192, 192, 19 2)
>      Selection.ShapeRange.Fill.Transparency = 0.5
>      Selection.ShapeRange.Rotation = 315
>      Selection.ShapeRange.LockAspectRatio = True
>      Selection.ShapeRange.Height = CentimetersToPoints(3.47)
>      Selection.ShapeRange.Width = CentimetersToPoints(19.09)
>      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
>      ActiveDocument.ExportAsFixedFormat OutputFileName:= _
>          "C:Usersd40442DocumentsLiberKeyAppsPDFTKBuilde rApp
> PDFTKBuildermonsieur toto.pdf" _
>          , ExportFormat:=wdExportFormatPDF, OpenAfterExport :=True,
> OptimizeFor:= _
>          wdExportOptimizeForPrint, Range:=wdExportAllDocume nt, From:=1,
> To:=1, _
>          Item:=wdExportDocumentContent, IncludeDocProps:= True,
> KeepIRM:=True, _
>          CreateBookmarks:=wdExportCreateNoBookmarks,
> DocStructureTags:=True, _
>          BitmapMissingFonts:=True, UseISO19005_1:úlse
> End Sub

> '************

Bonjour,

J'imagine que cette question est rendue obsolète par la solution trouv ée
avec PDFtK ?
Avatar
Gloops
Hello, je t'invite à comparer ce qui apparaît au début et à la fi n de
ceci :)

Est-ce bien normal ?

Je ne suis pas trop entré dans le reste, ça demande de bien se
concentrer, mais déjà sur ce point je trouve que ça mérite d'êt re sûr.

_____________________________________________
Alfred WALLACE a écrit, le 14/06/2011 11:22 :
Set Dc = Wd.Documents.new
Wd.Visible = True
'Reste de la macro
'Traitement du fichier word

'CETTE MACRO EST TIREE DE L'ENREGISTREUR DE MACRO DE WORD
'j'ai seulement rajouter le "Wd." devant chaque appel pour (je
pensais) bien faire référence
'à l'objet word crée plus haut.
Wd.Documents.Add Template:="Normal", NewTemplate:úlse,
DocumentType:=0
Avatar
Alfred WALLACE
Gloops,
merci pour ton aide, je vois que tu me suis à la trace ! :-)

Ceci dit, non, je répete il y a bien 2 choses et donc 2 questions
différentes.
désolé c'est vrai que mes messages sont assez (trop) longs
mais, je ne vois pas comment expliquer mon soucis sans décrire
ce qui ce passe.

je récapepette :

1 - l'outil PDFtk peut être utilisé en ligne de commande, et
mon premier message demande comment puis-je créer la ligne
de commande qui va bien. je crois que par "shell" je peux m'en sortir.

2 - l'outil PDF me sert à apposer des filigranes dans un document.
ces filigranes sont eux-même des documents PDF avec le nom du
"propriétaire".
Ce que j'essaye de faire par macro vba, est de piloter word afin que,
celui-ci
fasse le filigrane, et enregistre le document au format PDF (par un
export).


Ce que j'ai réussi à faire, est une macro vba pour word (donc dans
word),
et cette macro fonctionne. j'ai "rappatrié" le code dans mon code vba,
celui-ci
ne genere aucune érreur, ouvre word, crée un document vierge dans
word,
et, effectivement execute toutes les instructions du code de la macro
word ....
le seul pb, est que sur la page word, il n'y a rien du tout.

j'ai la version 2007 de word, excel 2007 ...

Merci pour ton soutien







On 14 juin, 14:38, Gloops wrote:
Hello, je t'invite à comparer ce qui apparaît au début et à la fi n de
ceci :)

Est-ce bien normal ?

Je ne suis pas trop entré dans le reste, ça demande de bien se
concentrer, mais déjà sur ce point je trouve que ça mérite d'êt re sûr.

_____________________________________________
Alfred WALLACE a écrit, le 14/06/2011 11:22 :







>          Set Dc = Wd.Documents.new
>          Wd.Visible = True
>          'Reste de la macro
>          'Traitement du fichier word

> 'CETTE MACRO EST TIREE DE L'ENREGISTREUR DE MACRO DE WORD
> 'j'ai seulement rajouter le "Wd." devant chaque appel pour (je
> pensais) bien faire référence
> 'à l'objet word crée plus haut.
> Wd.Documents.Add Template:="Normal", NewTemplate:úlse,
> DocumentType:=0
Avatar
Gloops
Alfred WALLACE a écrit, le 14/06/2011 16:27 :
Gloops,
merci pour ton aide, je vois que tu me suis à la trace ! :-)

Ceci dit, non, je répete il y a bien 2 choses et donc 2 questions
différentes.
désolé c'est vrai que mes messages sont assez (trop) longs
mais, je ne vois pas comment expliquer mon soucis sans décrire
ce qui ce passe.



ça devient plus dur, mon Thunderbird me met les sujets les plus récen ts
en tête, en général c'est une bonne chose, mais là je vois un eff et
secondaire auquel je n'avais pas pensé : si je reste quelques jours san s
me connecter, les sujets auxquels j'ai répondu apparaissent plus bas,
j'ai intérêt à me rappeler. Il faudra que je passe un peu de temps à
gérer ça au mieux, je devrais au minimum avoir une couleur différen te
sur les sujets sur lesquels je suis intervenu.

Bon, alors à ce que je comprends, pour pouvoir en dire plus, il faudra
que j'exécute moi-même en mode pas à pas pour pouvoir comprendre de quoi
il retourne. Je vais voir si j'arrive à faire cohabiter ça avec les
ruptures de rythme que j'ai à gérer ces jours-ci.

Avant que je me sois engagé là-dedans, ce que je peux faire c'est don ner
quelques conseils généraux :
- code bien structuré
- noms de variables clairs
- commentaires aux endroits les plus judicieux pour aider à faire
comprendre l'intention (pas un commentaire qui recopie l'aide de
l'instruction, bien sûr)

Si tu as utilisé un code généré par l'enregistreur, bien prendre le
temps de comprendre son fonctionnement, les rôles des différentes
variables utilisées ...