Export excel to word - VBA

brunos31

XLDnaute Nouveau
Bonjour,

Je bloque sur deux problèmes depuis plusieurs jours, et je m'en remets à vous pour avoir quelque idée.

J'ai un fichier excel avec une macro qui suivant un template word, permet de remplacer des données ciblé dans word par les données excel.

1 - Mon premier problème étant que la macro ne prend en compte que la première ligne du tableau et que je voudrais qu'a chaque ligne de tableau trouvé, une nouvelle page word est générée en prennant en compte le template de la première page.

2 - Et mon autre problème est d'y insérer une image suivant un lien inscrit dans le tableau excel, un peu comme le texte, soit remplacer une cible dans word par l'image.

Je vous join le fichier en question pour plus de précision :)

Et voici le code de base:
Code:
Option Explicit
Dim WS_Gen As Worksheet
Dim NOM, PRENOM, ADRESSE, TEL, VILLE
Dim objWord As Word.Application
Dim docWord As Word.Document
Dim docWordF As Word.Document
Sub Commandok_Click()
    
    Dim f As Range
    Dim objWord As Word.Application
    Dim docWord As Word.Document
    Dim docWordF As Word.Document
    
    Set objWord = Nothing
    Set docWord = Nothing
    
NOM = Sheets("Liste").Cells(2, 1).Value
PRENOM = Sheets("Liste").Cells(2, 2).Value
ADRESSE = Sheets("Liste").Cells(2, 3).Value
TEL = Sheets("Liste").Cells(2, 4).Value
VILLE = Sheets("Liste").Cells(2, 5).Value


    Dim Fichier As String


    Set objWord = CreateObject("Word.Application")
    Set docWord = objWord.Documents.Open(ThisWorkbook.Path & "\Liste.doc")
    objWord.Visible = True
    
    
    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "-NOM-"
        .Replacement.Text = NOM
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll
    
    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "-PRENOM-"
        .Replacement.Text = PRENOM
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll
    
    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "-ADRESSE-"
        .Replacement.Text = ADRESSE
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll
    
        objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "-TEL-"
        .Replacement.Text = TEL
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll
    
        objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
        .Text = "-VILLE-"
        .Replacement.Text = VILLE
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=wdReplaceAll

    
    objWord.ChangeFileOpenDirectory "C:\" 'Remplacer par l'URL où est le fichier word
    objWord.ActiveDocument.SaveAs Filename:=Sheets("Liste").Cells(2, 1).Values
    objWord.FileDialog(msoFileDialogSaveAs).Execute
    objWord.FileDialog(msoFileDialogSaveAs).Execute
    Unload Me
End Sub

En vous remerciant d'avance pour votre aide,
Cdlt,
Bruno
 

Pièces jointes

  • Liste.zip
    24.6 KB · Affichages: 36
  • Liste.zip
    24.6 KB · Affichages: 32
  • Liste.zip
    24.6 KB · Affichages: 32

PMO2

XLDnaute Accro
Re : Export excel to word - VBA

Bonjour,

Je ne me suis occupé que du cas 1
1 - Mon premier problème étant que la macro ne prend en compte que la première ligne du tableau et que je voudrais qu'a chaque ligne de tableau trouvé, une nouvelle page word est générée en prennant en compte le template de la première page.
Les Documents Word seront créés dans le dossier contenant le classeur/programme Excel.
 

Pièces jointes

  • Export excel to word - VBA.zip
    27.6 KB · Affichages: 52

PMO2

XLDnaute Accro
Re : Export excel to word - VBA

Bonjour,

2 - Et mon autre problème est d'y insérer une image suivant un lien inscrit dans le tableau excel, un peu comme le texte, soit remplacer une cible dans word par l'image.
Une autre version avec le traitement des images.

En l'état, les images sont stockées dans le même répertoire que le programme Excel.
J'ai préféré mettre le code en Late Binding (liaison tardive) pour éviter d'avoir l'obligation de mettre une référence à Word.
Code:
'#######################################################################
'### A NOTER : le code est exécuté en Late Binding (Liaison tardive) ###
'###        il ne nécessite plus la référence à Microsoft Word       ###
'#######################################################################
Sub Commandok_Click()
Dim S As Worksheet
Dim LastLig&
Dim i&
Dim j&
Dim objWord As Object 'Word.Application Late Binding (Liaison tardive)
Dim docWord As Object 'Word.Document Late Binding (Liaison tardive)
Dim varWhat As Variant
'---
'--- Initialisation des mots recherchés ---
varWhat = Array("-NOM-", "-PRENOM-", "-ADRESSE-", "-TEL-", "-VILLE-")
'--- La feuille Excel et sa dernière ligne ---
Set S = Sheets("Liste")
LastLig& = S.[a1].End(xlDown).Row
'--- Les documents Word ---
Set objWord = CreateObject("Word.Application")
'objWord.Visible = True   'pas nécessaire de voir Word
For i& = 2 To LastLig&
  Application.StatusBar = "DocumentWord " & i& - 1 & "/" & LastLig& - 1
  Set docWord = objWord.Documents.Open(ThisWorkbook.Path & "\Liste.doc")
     
    '°°° Insertion de l'image °°°
  If S.Cells(i&, 6) <> "" Then
    docWord.Tables(1).Cell(Row:=1, Column:=1).Select
    With objWord.Selection
      .Text = ""
      On Error Resume Next
      .InlineShapes.AddPicture Filename:=ThisWorkbook.Path & "\" & S.Cells(i&, 6), _
          LinkToFile:=False, SaveWithDocument:=True
      Err.Clear
      On Error GoTo 0
    End With
  End If
    '°°°°°°°°°°°°°°°°°°°°°°°°°°°°
  
  For j& = LBound(varWhat) To UBound(varWhat)
    objWord.Selection.Find.ClearFormatting
    With objWord.Selection.Find
      .Text = varWhat(j&)
      .Replacement.Text = S.Cells(i&, j& + 1)
      .Forward = True
      .Wrap = 1   'wdFindContinue Late Binding (Liaison tardive)
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    objWord.Selection.Find.Execute
    objWord.Selection.Find.Execute Replace:=2   'wdReplaceAll Late Binding (Liaison tardive)
  Next j&
  objWord.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\" & S.Cells(i&, 1)
  objWord.ActiveDocument.Close 0    'wdDoNotSaveChanges Late Binding (Liaison tardive)
Next i&
'--- Ferme Word et nettoyage ---
Application.StatusBar = "Fermeture de Word"
objWord.Quit
Set docWord = Nothing
Set objWord = Nothing
Application.StatusBar = False
'---
Unload Me
End Sub
 

Pièces jointes

  • Export excel to word avec images - VBA.zip
    131.6 KB · Affichages: 53

Rep

XLDnaute Junior
Re : Export excel to word - VBA

Bonjour,


Une autre version avec le traitement des images.

En l'état, les images sont stockées dans le même répertoire que le programme Excel.
J'ai préféré mettre le code en Late Binding (liaison tardive) pour éviter d'avoir l'obligation de mettre une référence à Word.

Bonjour,

Tiens, je ne connaissais pas le Late Binding... ça m'intéresse fortement, sachant que j'ai développé une petite appli Excel qui alimente des matrices Word... sauf que mon Excel est en version 2013 et que les utilisateurs, pour la plupart, utilisent une version 2010 ! Résultat, la référence à Word n'est pas dans la bonne version et je dois rétablir la référence en ouvrant le fichier Excel sous Excel 2010 ; pas très pratique.

Le late binding permet de s'affranchir de cette problématique? Quelles sont les contraintes de cette fonction?

Merci pour les réponses,
 

PMO2

XLDnaute Accro
Re : Export excel to word - VBA

Bonjour,

@ rep
Le late binding permet de s'affranchir de cette problématique?
Oui.

Quelles sont les contraintes de cette fonction?
Voilà comment je procède lorsque j'ai recours à Automation ("L'automation consiste à utiliser les services d'un logiciel dans une application informatique."). Je prends l'exemple de Word piloté à partir d'Excel.
1) Je monte, dans le VBE, la référence à Word. Je suis en Early Binding.

Chez moi :
Library Word
C:\Program Files\Microsoft Office\Office12\MSWORD.OLB
Microsoft Word 12.0 Object Library

Cela me permet de bénéficier de l'IntelliSense et de la visualisation des objets Word dans l'Explorateur d'objets.

2) Une fois le développement du projet terminé, je recherche toutes les constantes appartenant à Word et les remplace par leur valeur.
Ex :
objWord.Selection.Find.Execute Replace:=2 'wdReplaceAll

Je déclare toutes les variables objet Word comme Object
Ex :
Dim objWord As Object 'Word.Application
Dim docWord As Object 'Word.Document

3) Je retire, dans le VBE, la référence à Word. Je suis en Late Binding.

4) Je fais tourner le programme pour voir si je n'ai pas oublié quelque chose.

C'est très peu contraignant et l'avantage est énorme : plus besoin de référence.
 

Discussions similaires

Statistiques des forums

Discussions
314 493
Messages
2 110 197
Membres
110 703
dernier inscrit
papysurf