Automatisation Word par Excel : caractères aléatoires supprimés

Hello,

Je ne sais pas si vous allez pouvoir m'aider, car le sujet qui suis requiert également Word mais je tente ma chance quand même

Alors voilà la petite histoire : je bosse un projet de générateur de contrat "automatique" via excel pour remplir automatiquement des champs dans un doc word préformaté, et avec un système de signet pour supprimer des paragraphes inutile du doc word.

Mon projet est quasiment terminé mais je bute sur une impasse : lors que la suppression des paragraphes inutiles via les signets, certains paragraphe ce voient tronqués de quelques lettres (voir l'exemple du doc pdf joint, où j'ai les 3 premières lettres du mon "Contract" en page 4 qui sont supprimées) .

J'ai essayer de rajouter des caractères en plus pour pallier le problème, mais difficile de prévoir l'aléatoire : dés fois ce ne sont du 2 caractères qui sont supprimés, et fois pas du tout...

Je vous joint aussi mon générateur en PJ.

Merci pour votre aide et bonne fin de soirée

Bonjour,

Voici une proposition de code avec l'exemple modifié

Sub attestation_Test()
Dim Ws As Worksheet, i As Integer, Cible As Object, Ndf As String

    Set Ws = Sheets("Test")
    Ws.OLEObjects("Objet_modele_doc").Verb xlVerbOpen

    Set WordApp = GetObject(, "Word.Application")
    Set WordDoc = WordApp.ActiveDocument
    WordApp.Visible = False

    With WordDoc
        With .Tables(1)
            .Cell(1, 1).Range.Text = Ws.Range("C3").Text & " " & Ws.Range("C4").Text & " " & Ws.Range("C5").Text
            .Cell(2, 1).Range.Text = Ws.Range("C6").Text
            .Cell(3, 1).Range.Text = Ws.Range("C7").Text & " " & Ws.Range("C8").Text
            .Cell(4, 1).Range.Text = Ws.Range("C8").Text
        End With

        For i = 16 To 11 Step -1
            If Not Ws.Cells(i, 8).Value = "" Then
                For Each Cible In WordDoc.Paragraphs
                    Cible.Range.Select
                    If Trim(Cible.Range.Words(1)) = Ws.Cells(i, 9).Value Then Cible.Range.Delete
                Next Cible
            End If
        Next i

        Ndf = ThisWorkbook.path & "\" & Ws.Range("C13") & ".pdf"
        .ExportAsFixedFormat OutputFileName:=Ndf, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
    End With

    WordDoc.Close savechanges:=wdDoNotSaveChanges
    WordApp.Application.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    MsgBox "ok"
End Sub

Pour la méthode utilisée ici on se réfère au 1er mot du paragraphe à effacer

Pour l'adresse du client il y a un tableau de 4 lignes (à bordures transparentes)=> tables(1)

Avec mes tests ça à l'air de fonctionner

Pierre

Bonjour,

Merci pour votre réponse.

Je vais regarder votre code et essayer de l'adapter.

Je vous remercie.

Bon dimanche.

Cordialement