Rechercher et Remplacer dans Word par Macro Excel

Résolu
Passager10 Messages postés 6 Date d'inscription vendredi 15 juin 2007 Statut Membre Dernière intervention 15 juin 2007 - 15 juin 2007 à 15:05
jrivet Messages postés 7393 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 - 15 oct. 2007 à 08:21
Bonjour a vous,
    Voila je vous expose mon probleme :

Je cherche par une macro sous excel à ouvrir un document modèle Word que j'ai créé qui me permettra de remplacer certains textes par d'autres. Je m'explique :
    1) J'ai un document Word qui est une lettre classique du type : 
            "NOM Prenom"
           Je soussigné, NOM Prenom, bla bla bla ..."
    Ca c'est fait

    2) Donc sous excel je lance une macro (plutot un UserForm) qui me demande d'entrer les NOM et     Prénom qui sont stockés dans 2 cellules
    Ca aussi
 
    3) Et je voudrais remplacer mon texte NOM par ce qu'il y a dans  la premiere cellule et Prenom ce qu'il y a dans la 2eme.

Je vous préviens je n'est pas suivi de cours de VB enfin tres peu et je vous montre ce que j'ai fait pour l'instant.
Soyez indulgents s'il vous plait

Private Sub Facture_Click()

Dim AppWord As Object
Set AppWord = CreateObject("Word.Application")
AppWord.Documents.Add "Ou_vous_voulez_Modele.dot"
AppelWord.ActiveDocument.SaveAs "Ou_vous_voulez_Modele.doc"
AppelWord.Documents.Open "Ou_vous_voulez_Modele.doc"
AppelWord.Visible = True

    With AppWord.Selection.Find
        .Text = "NOM"
        .Replacement.Text = Sheets("Feuille").Range("A1").Value
        .ClearFormatting
        .Forward = True
        .Execute Replace:=wdReplaceAll
End With
        
With AppWord.Selection.Find
        
        .Text = "Prenom"
        .Replacement.Text = Sheets("Feuille").Range("A2").Value
        .ClearFormatting
        .Forward = True
        .Execute Replace:=wdReplaceAll
End With

AppWord.ActiveDocument.Close
AppWord.Application.Quit
Set AppWord = Nothing

End Sub

Alors c'est du barbare je me doute mais sous Word ca fonctionne mais seulement si mon curseur est situé en début de page.
Voila c'est un peu long mais j'essaye d'etre clair (c pas gagné)

19 réponses

jrivet Messages postés 7393 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
15 juin 2007 à 16:20
Re, Petite correction apres utilisation (j'avais pas rendu App Visible)

ATTENTION AppWord = APPLICATION

J'ai testé et cela semble fonctionner chez moi.
Pour tout avouer je n'ai pas testé avec Sheets( "Feuille" ).Range("A1").Value Mais Avec "TOTO" par exemple mais cela ne devrait pas faire de difference.
Option Explicit

'Depuis Excel ajoute la référence suivante
'dans l'ide VBA Menu Outils => Références => Microsoft Word 9.0 Object Library
'(9.0) ou équivalent

Private Sub Facture_Click()

Dim AppWord As New Word.Application
   
   'J'avais oublier de le rendre visible
   AppWord.Visible = True
   Call AppWord.Documents.Add("Ou_vous_voulez_Modele.dot")
   Call AppWord.ActiveDocument.SaveAs("Ou_vous_voulez_Modele.doc")
   Call AppWord.Selection.HomeKey(wdStory)
   
   'Appelle la procédure (evite les répétitions
   Call FindAndReplace(AppWord, "Fichier", Sheets("Feuille").Range("A1").Value)
   Call FindAndReplace(AppWord, "PRENOM", Sheets("Feuille").Range("A2").Value)
   
   'Si pas true alors tu ne sauve pas les modif
   Call AppWord.ActiveDocument.Close(True)   'CORRECTION AppWord.APPLICATION INUTILE AppWORD APPLICATION
   Call AppWord.Quit
   Set AppWord = Nothing

End Sub<hr />

Private Sub FindAndReplace(ByRef WApp As Word.Application, ByVal What As String, ByVal ForWhat As String)
   With WApp.Selection.Find
       .Text = What
       .Replacement.Text = ForWhat
       .ClearFormatting
       .Forward = True
       .Execute Replace:=wdReplaceAll
   End With
End Sub<hr />
, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
1