Microsoft 365 VBA export Excel vers Word : Bnq congé 0

[3xceln4ute]

Bonjour,

Je désire automatiser la création de lettre en remplaçant les balises dans le modèle Word par les données correspondantes dans le tableau Excel.

La macro devra s'appliquer à chaque ligne cochée.

J'ai avec la macro ci-dessous, mais malheureusement, le test est infructueux. Je vois le modèle Word s'ouvrir furtivement, mais rien ne se passe.

Sub LettresMaldie0()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Suivi Bnq maladie 0") ' Nom de la feuille


    Set wdApp = CreateObject("Word.Application")


    wdApp.Visible = True ' Pour voir le processus
    wdApp.Activate


    Dim wdDoc As Object
    Dim i As Long
    Dim dateText As String


    dateText = ws.Range("B7").Value ' Utilisation de .Value


    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If ws.Cells(i, 1).Value = True Then ' Cases à cocher
        On Error Resume Next ' Ajoutez cette ligne pour gérer les erreurs
        Set wdDoc = wdApp.Documents.Open("C:\Users\ub\Downloads\Gestion disciplinaire 2024\Test Bnq maladie 0\Modèle_Banque de maladie 0.docx", ReadOnly:=False)
        If wdDoc Is Nothing Then
            MsgBox "Impossible d'ouvrir le document Word. Chemin : C:\Users\ub\Downloads\Gestion disciplinaire 2024\Test Bnq maladie 0\Modèle_Banque de maladie 0.docx"
            Exit Sub ' Quitte la macro si le document ne peut pas être ouvert
        End If
        On Error GoTo 0 ' Reset le gestionnaire d'erreur


            ' Recherche et remplacement des balises
            ReplaceWordContent wdDoc, "[NOM]", ws.Cells(i, 2).Value
            ReplaceWordContent wdDoc, "[MATRICULE]", ws.Cells(i, 3).Value
            ReplaceWordContent wdDoc, "[DATE]", dateText


            ' Enregistrement et fermeture
            Dim savePath As String
            savePath = "C:\Users\ub\Downloads\Gestion disciplinaire 2024\Test Bnq maladie 0" & ws.Cells(i, 2).Value & ".docx"
            wdDoc.SaveAs2 savePath
            wdDoc.Close False


            ' Décocher la case et écrire la date et l'heure de génération
            ws.Cells(i, 1).Value = False
            ws.Cells(i, 7).Value = "Généré le " & Date & " à " & Time
        End If
    Next i


    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
End Sub


' Fonction pour remplacer le contenu dans Word
Private Sub ReplaceWordContent(doc As Object, findText As String, replaceText As String)
    With doc.Content.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Auriez-vous une idée sur ce qui ne tourne pas rond ?

En passant, je vous souhaite, à toutes et à tous, une bonne et heureuse année.

Cordialement.

 

[patricktoulon]

Bonjour
tout d'abords meilleurs veux

Alors
1° tes checkbox ne sont pas liés aux cellules en colonne "A"
pour boucler sur les valeur true ca être compliqué
j'ai du le faire

2°oui en effet la méthode saveAs2 de word qui est l'hommologue de savecopyAs d'excel a des contraintes
en effet en excel le document original reste le document actif mais chez word c'est le dernier document créé
et bien d'autre bug que je n'ai jamais compris

3°d'autre part tu peux toujours courrir a éssayer de faire des replace dans le text directement
on est plus sur word 2003 depuis longtemps
il te faut donc insérer des signets(bookMark)

j'ai donc ajouté les signets

• "Nom"
• "Matricule"
• "Datex"

parti de là a partir du fichier excel tu peux modifier la valeur du range.text de ces bookmarks(signets)

donc au regard du problème 2
tant pis ca durrera un peu plus longtemps si il y en a beaucoup mais on ouvre et modifie et ferme l'original a chaque tour de boucle

Sub GenerateLetters()
    Dim WordApp As Object, WordDoc As Object, ws As Worksheet, savePath$, Chemin$
    'Chemin = "C:\Users\uboud7t\Downloads\Gestion disciplinaire 2024\Test Bnq maladie 0\Modèle_Banque de maladie 0.docx"
      Chemin = ThisWorkbook.Path & "\Modèle_Banque de maladie 0.docx"

    Set ws = Feuil6
    Set WordApp = CreateObject("word.application")
    'WordApp.Visible = True
    For i = 9 To ws.Cells(Rows.Count, "b").End(xlUp).Row
        If ws.Cells(i, 1) = True Then
            Set WordDoc = WordApp.documents.Open(Chemin)    'ouvre document Word

            WordDoc.Bookmarks("Nom").Range.Text = ws.Cells(i, 2)
            WordDoc.Bookmarks("Matricule").Range.Text = ws.Cells(i, 3)
            WordDoc.Bookmarks("Datex").Range.Text = ws.[B7]


           'savePath = "C:\Users\uboud7t\Downloads\Gestion disciplinaire 2024\Test Bnq maladie 0" & ws.Cells(i, 2).Value & ".docx"
            savePath = ThisWorkbook.Path & "\Test Bnq maladie 0" & ws.Cells(i, 2).Value & ".docx"
            WordDoc.SaveAs savePath
            WordDoc.Close False
        End If

        ws.Cells(i, 5) = Date
    Next
    WordApp.Quit
    MsgBox "Terminé"

End Sub

ci joint le fichier excel et le fichier word avec ses signets
remet tes bons chemins d'accè dans le code

bye!! @+
Patrick

 

[Phil69970]

Bonjour à tous

Une autre approche ..... sans Word .....

Merci de ton retour

 

[patricktoulon]

re
bonjour @Phil69970
meileurs veux pour 2024
pas mal du tout de passer par du pdf
c'est imprimable , maillable
et le pdf tout le monde peut l'ouvrir même sans app acrobat il suffit d'avoir chrome ou ff ou opera et autres

 

[Phil69970]

Re

Patrick
Merci à toi et meilleurs vœux à toi aussi ainsi qu'a tous les membres XLD

Voici une version amélioré

 

[Phil69970]

Bonjour à tous

@3xceln4ute

Plusieurs solutions et aucun retour cela donne envie pour la prochaine fois !!!