Outil de génération d'offre
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,
Répondre avec citation
et si celle-ci est pertinente pensez à voter 
Partager