Interaction fichiers xlsm et dotm, problème de contenu

Question

Bonjour à tous, je me présente, Nicolas 32 ans je suis technicien en solution et sécurisation d'impression pour les professionnels.

J'ai récupéré dans mon travail une tache un peu complexe mais très intéressante.

Nos commerciaux travaillent sur un fichier Excel au format xlsm que j'ai créé et qui fonctionne très bien.

A partir de la il faudrait que en appuyant sur un bouton il génère automatiquement un fichier Word avec toutes les infos nécessaire.

Petite précision:

Mon fichier Excel contient un onglet nommé "Propal" contenant toutes les informations à mettre dans le Word.

Le fichier Word final sera une fusion entre plusieurs fichiers dotm contenant des signets et des tableaux contenant des signets (mais pas d'images).

J'ai déjà réalisé une bonne partie de la macro qui fonctionne bien.

le seul soucis que j'ai, c'est que lorsque je fais la fusion des fichiers dotm en utilisant "InsertAfter" je n'ai que du texte brut. Tout le reste (tableau, signet et mise en forme) disparait.

Voici une petite partie de mon code en espérant que ça vous serve

Dim AppWord As Object
    Dim Doc As Object

    openCom = Worksheets("Propal").Range("G9").Value
    openMach = Worksheets("Propal").Range("G24").Value
    openSol1 = Worksheets("Propal").Range("G38").Value
    openSol2 = Worksheets("Propal").Range("G41").Value
    openSol3 = Worksheets("Propal").Range("G44").Value
    openFonct = "Fonctionnement.dotm"
    openSolFiMach = Worksheets("Propal").Range("G59").Value

    openFin = "Fin.dotm"

'crée une instance de Word
    Set AppWord = CreateObject("Word.Application")

'Récupère le chemin de Mes Documents
    Const Cible = &H2B '\Program Files\Common
    Dim objShell As Object
    Dim objFolder As Object, objFolderItem As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Cible)
    Set objFolderItem1 = objFolder.Self
    With AppWord

        .Visible = True

    cheminCommon = objFolderItem1.Path
    chemin2 = "\ACI"
    chemin3 = "\Word"
    chemin4 = "\Images"
    chemin5 = "\machines_images"
    chemin6 = "\solution_images"
    chemin7 = "\Fiches"

    cheminACI = cheminCommon & chemin2
    cheminWord = cheminACI & chemin3
    cheminImages = cheminACI & chemin4
    cheminMachinesImages = cheminImages & chemin5
    cheminImagesSolutionImages = cheminImages & chemin6
    cheminFiches = cheminACI & chemin7
    cheminOpenCom = cheminWord & "\" & openCom
    cheminOpenMach = cheminWord & "\" & openMach
    cheminOpenSol1 = cheminWord & "\" & openSol1
    cheminOpenSol2 = cheminWord & "\" & openSol2
    cheminOpenSol3 = cheminWord & "\" & openSol3
    cheminOpenFonct = cheminWord & "\" & openFonct
    cheminOpenSolFiMach = cheminWord & "\" & openSolFiMach
    cheminOpenFin = cheminWord & "\" & openFin

'ouvre un document, ATTENTION de mettre l'extension ".doc"
    Set Doc = .Documents.Open(cheminOpenCom)
'----------------------------------------------------------------------------------------------------------------------------------------------------------
    'ouverture et insertion machine

Dim wrdMach As Object
Set wrdApp1 = CreateObject("Word.Application")
wrdApp1.Visible = False
Set wrdDoc2 = wrdApp1.Documents.Open(cheminOpenMach)
Doc.Content.InsertAfter wrdDoc2.Content
wrdApp1.Quit
'----------------------------------------------------------------------------------------------------------------------------------------------------------
    'si solution ouverture et insertion

If Worksheets("Propal").Range("G32").Value <> " " Then
    Dim wrdSol1 As Object
    Set wrdApp2 = CreateObject("Word.Application")
    wrdApp2.Visible = False
    Set wrdDoc3 = wrdApp2.Documents.Open(cheminOpenSol1)
    Doc.Content.InsertAfter wrdDoc3.Content
    wrdApp2.Quit
End If

If Worksheets("Propal").Range("G33").Value <> " " Then
    Dim wrdSol2 As Object
    Set wrdApp3 = CreateObject("Word.Application")
    wrdApp3.Visible = False
    Set wrdDoc4 = wrdApp3.Documents.Open(cheminOpenSol2)
    Doc.Content.InsertAfter wrdDoc4.Content
    wrdApp3.Quit
End If

If Worksheets("Propal").Range("G34").Value <> " " Then
    Dim wrdSol3 As Object
    Set wrdApp4 = CreateObject("Word.Application")
    wrdApp4.Visible = False
    Set wrdDoc5 = wrdApp4.Documents.Open(cheminOpenSol3)
    Doc.Content.InsertAfter wrdDoc5.Content
    wrdApp4.Quit
End If

'----------------------------------------------------------------------------------------------------------------------------------------------------------
    'ouverture et insertion fonctionnement
    Dim wrdFonct As Object
    Set wrdApp5 = CreateObject("Word.Application")
    wrdApp5.Visible = False
    Set wrdDoc6 = wrdApp5.Documents.Open(cheminOpenFonct)
    Doc.Content.InsertAfter wrdDoc6.Content
    wrdApp5.Quit

    'ouverture et insertion solution financiere machine
    Dim wrdSolFiMach As Object
    Set wrdApp6 = CreateObject("Word.Application")
    wrdApp6.Visible = False
    Set wrdDoc7 = wrdApp6.Documents.Open(cheminOpenSolFiMach)
    Doc.Content.InsertAfter wrdDoc7.Content
    wrdApp6.Quit

    'ouverture et insertion fin
    Dim wrdFin As Object
    Set wrdApp7 = CreateObject("Word.Application")
    wrdApp7.Visible = False
    Set wrdDoc8 = wrdApp7.Documents.Open(cheminOpenFin)
    Doc.Content.InsertAfter wrdDoc8.Content
    wrdApp7.Quit

Je remercie d'avance tous ceux qui qui vont prendre le temps de m'aider.

Nico

jmd · Answer

Joins ton xlsx et tes multiples dotm (bizarre ! ) simplifiés , ne mets que 3 affaires mon premier sentiment, c'est qu'il faudrait passer à Access ou autre SGBD. Mais on va voir, tu as sans doute fait trop compliqué. à te relire...

jmd · Answer

Re joins des fichiers anonymisés, et avec 3 colonnes et 5 lignes (aussi petits que possible pour simulation) à te relire...

dhany · Answer

Check-up complet effectué, mon Commandant ; tous les voyants sont au vert, RAS, l'avion peut décoller. ici le copilote de la compagnie Air Kansas qui vous remercie de votre retour d'infos. (en cas de problème, les caissons de dépressurisation aussi sont en bon état) dhany...