Discussion :

[Posta]

Bonjour à tous,

Je sollicite vos lumières pour avancer sur un code VBA permettant l'échange d'information entre Excel et Microsoft Word. (je pense que ce genre d'outils pourra servir à d'autres)

Le contexte : je dois créer un outil excel qui soit capable de générer des offres sous word à partir d'un ensemble de données.

Les différents types de données :
– les tables, elles ont pour objectifs selon le besoin d'être filtrées pour après récupéré certaines données filtrer pour les envoyer sous WORD (feuille : "SOLUTION", "REF_ECF")
– les champs remplis de manière spécifique permettront aussi de compléter des champs sous word.

Pour l'instant j'ai réussi à :
– pouvoir remplir des champs word via excel (feuille : "CADRAGE") cf macro EXT_CHAMP
– filtrer et extraire les éléments d'un tableau (feuille : "REF") cf macro EXT_REF vers une autre feuille REF_EXT

Mais je n'arrive pas à prendre le tableau généré et l'envoyer dans word tentative avec la macro "EXT_TAB_WORD" et c'est sur ce dernier point que j'aimerai avoir de l'aide si possible.

L'objectif est d'envoyer le tableau "BDD_REF_EXT" de la feuille "REF_ECF_EXT" vers le word après la phrase "Silicium et nostradae cubitus."

J'ai différents messages d'erreur, je ne sais pas si le code arrive à :
– sélectionner l'objet tab "BDD_REF_EXT" et le copier ;
– positionner le curseur.

---

Le code en question :

Sub ExportToWordAfterPhraseWithExistingFile()
Dim wdApp As Object 'Objet Word.Application
Dim wdDoc As Object 'Objet Word.Document
Dim ws As Worksheet
Dim tbl As ListObject
Dim rng As Range ' Plage de destination dans Word
Dim findPhrase As String ' Phrase à rechercher dans le document Word
Dim nom_fichier As Variant ' Nom du fichier Word existant

' Sélectionner le fichier Word existant
nom_fichier = Application.GetOpenFilename("Word files (*.docx), *.docx")
If nom_fichier = "Faux" Then
MsgBox "Aucun fichier sélectionné. Exportation annulée."
Exit Sub
End If

' Créer une nouvelle instance de Word
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True ' Afficher Word

' Ouvrir le document Word existant
Set wdDoc = wdApp.Documents.Open(nom_fichier)

' Rechercher la phrase dans le document Word
findPhrase = "Silicium et nostradae cubitus."
With wdDoc.Range
If .Find.Execute(findPhrase) Then
' Définir le curseur juste après la phrase trouvée
.Collapse Direction:=wdCollapseEnd
' Set rng = ActiveDocument.Content
Else
MsgBox "Phrase introuvable dans le document Word. Exportation annulée."
wdDoc.Close False ' Fermer le document Word sans enregistrer les modifications
Exit Sub
End If
End With

' Définir la plage de destination après la phrase


' Boucler à travers toutes les feuilles du classeur Excel
For Each ws In ThisWorkbook.Worksheets
' Vérifier si le tableau "tab" existe dans la feuille
On Error Resume Next
Set tbl = ws.ListObjects("BDD_REF_EXT")
On Error GoTo 0

If Not tbl Is Nothing Then
' Copier le tableau "tab" dans Excel
tbl.Range.Copy
With wdDoc.Range
' Coller le tableau dans Word juste après la phrase spécifiée
.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False ' Coller le tableau sans conserver les liens Excel

' Insérer un saut de page après le tableau
' rng.Collapse Direction:=0 ' Déplacer le curseur au début de la plage de destination
'rng.Move wdParagraph, 1 ' Aller à la ligne suivante
End With
Else
MsgBox "Le tableau ""tab"" n'a pas été trouvé dans la feuille de calcul. Exportation annulée."
wdDoc.Close False ' Fermer le document Word sans enregistrer les modifications
Exit Sub
End If
Next ws


MsgBox "Exportation vers Word terminée avec succès !"


wdDoc.Save
wdDoc.Close

Set wdDoc = Nothing

End Sub

---

Merci pour votre aide précieuse,