Modifier une shape Word via Excel

Version imprimable

Bonsoir,
Après de nombreuses recherche je n'ai pas réussi à tomber sur ce que je voulais.
J'aimerais pouvoir modifier la valeur texte d'une shape dans Word, lorsque que je viens de créer ce document word via excel.
Voici le code que j'ai essayé sans résultat :
Code:

1 2 3 4 5 6 7 8 9 10 11 Set WordApp = CreateObject("word.Application") WordApp.Visible = True WordApp.Documents.Open LeRep1 With WordApp.Documents.Shapes.Range(Array("Zone de texte 10")) .Text = sNomDossier End With End Sub
La ligne erreur est la ligne "With WordApp.Documents.Shapes.Range(Array("Zone de texte 10"))" ...
Je pense que la sélection du fichier word n'est pas bonne mais je ne sais pas comment le résoudre..
Merci de votre aide
Cordialement.

Citation:

Envoyé par Patouillou

Bonjour,

A adapter :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
Option Explicit
 
Sub ModifierLeTexteDUnAutoShape()
 
Dim WordApp As Word.Application  ' As Object si Word n'est pas référencé
Dim WordDoc As Word.Document   ' As Object si Word n'est pas référencé
Dim RepertoireFichier As String, sNomDossier As String, ChaineAChercher As String
Dim I As Integer
 
    Set WordApp = CreateObject("word.Application")
    With WordApp
 
         .Visible = True
         RepertoireFichier = "C:\Users\XXXX\" ' A adapter
         sNomDossier = "Nom du dossier"
         ChaineAChercher = "Zone de texte 10"
 
         Set WordDoc = .Documents.Open(RepertoireFichier & "XXXXX.docx") ' A adapter
         With WordDoc
              If .Shapes.Count > 0 Then
                 For I = 1 To .Shapes.Count
                     If .Shapes(I).Type = 1 Then  ' Se reporter aux 
                        With .Shapes(I)
                             If InStr(1, .TextFrame.TextRange.Text, ChaineAChercher, vbTextCompare) > 0 Then
                                .TextFrame.TextRange.Text = sNomDossier
                                'MsgBox .TextFrame.TextRange.Text
                             End If
                        End With
                     End If
                 Next I
              End If
              .Close savechanges:=True
         End With
         Set WordDoc = Nothing
 
         .Quit
 
     End With
     Set WordApp = Nothing
 
End Sub

09/10/2017, 20h33
Patouillou

Je te remercie!
Cela fonctionne parfaitement !
Merci de ton aide ;)