Générer des documents Word (dans Excel VBA) à partir d'une série de modèles de document

Question

Salut à tous. Je vais essayer de rendre ceci bref et simple. :)

J'ai

1. Une quarantaine de documents Word standard contenant une série de champs (Nom, adresse, etc.) à renseigner. Cette opération est historiquement manuelle, mais elle est répétitive et fastidieuse.
2. Un classeur dans lequel un utilisateur a rempli un grand nombre d'informations sur un individu.

J'ai besoin

• Une façon de programmer (à partir d'Excel VBA) d'ouvrir ces documents passe-partout, de modifier la valeur des champs de différentes plages nommées du classeur et d'enregistrer les modèles remplis dans un dossier local.

Si j'utilisais VBA pour éditer par programme des valeurs particulières dans un jeu de feuilles de calcul, je modifierais toutes ces feuilles de calcul pour qu'elles contiennent un ensemble de plages nommées pouvant être utilisées pendant le processus de remplissage automatique, mais je ne suis au courant d'aucun 'nommé'. champ 'dans un document Word.

Comment puis-je modifier les documents et créer une routine VBA afin de pouvoir ouvrir chaque document, rechercher un ensemble de champs pouvant devoir être renseignés et remplacer une valeur?

Par exemple, quelque chose qui fonctionne comme:

for each document in set_of_templates
    if document.FieldExists("Name") then document.Field("Name").value = strName
    if document.FieldExists("Address") then document.Field("Name").value = strAddress
    ...

    document.saveAs( thisWorkbook.Path & "\GeneratedDocs\ " & document.Name )
next document

Choses que j'ai considérées:

• Fusion et publipostage - mais cela est insuffisant, car il faut ouvrir chaque document manuellement et structurer le classeur en tant que source de données, je veux plutôt le contraire. Les modèles sont la source de données et le classeur les parcoure. En outre, le publipostage sert à créer de nombreux documents identiques à l'aide d'un tableau de données différentes. J'ai beaucoup de documents utilisant tous les mêmes données.
• Utilisez un texte de substitution tel que "# NAME #" et ouvrez chaque document pour une recherche et un remplacement. C’est la solution à laquelle je recourrais si rien de plus élégant n’est proposé.

Answer 1

Cela fait longtemps que je n'ai pas posé cette question et ma solution a été affinée de plus en plus. J'ai dû traiter toutes sortes de cas particuliers, tels que les valeurs directement issues du cahier de travail, les sections devant être générées spécialement à partir de listes, et la nécessité de remplacer les en-têtes et les pieds de page.

Il s'est avéré qu'il n'était pas suffisant d'utiliser des signets, car il était possible pour les utilisateurs de modifier ultérieurement des documents afin de modifier, d'ajouter et de supprimer des valeurs de marque de réservation des documents. La solution consistait en fait à utiliser keywords comme ceci:

Ceci est juste une page d'un exemple de document qui utilise certaines des valeurs possibles pouvant être automatiquement insérées dans un document. Plus de 50 documents existent avec des structures et des mises en page complètement différentes, et en utilisant des paramètres différents. La seule connaissance commune partagée par les documents Word et la feuille de calcul Excel est une connaissance de ce que ces valeurs d'espace réservé sont censées représenter. Dans Excel, cela est stocké dans une liste de mots-clés de génération de document, contenant le mot-clé, suivis d'une référence à la plage contenant réellement cette valeur:

Ce sont les deux ingrédients clés nécessaires. Maintenant, avec un code intelligent, tout ce que j'avais à faire était de parcourir chaque document à générer, puis de parcourir tous les mots-clés connus, puis de rechercher et de remplacer chaque mot-clé de chaque document.

---

Tout d’abord, j’ai la méthode wrapper, qui s’occupe de la maintenance d’une instance de Microsoft Word qui itère sur tous les documents sélectionnés pour la génération, de la numérotation des documents et du traitement de l’interface utilisateur (comme la gestion des erreurs, l’affichage du dossier à l’utilisateur, etc.). )

' Purpose: Iterates over and generates all documents in the list of forms to generate
'          Improves speed by creating a persistant Word application used for all generated documents
Public Sub GeneratePolicy()
    Dim oWrd As New Word.Application
    Dim srcPath As String
    Dim cel As Range

    If ERROR_HANDLING Then On Error GoTo errmsg
    If Forms.Cells(2, FormsToGenerateCol) = vbNullString Then _
        Err.Raise 1, , "There are no forms selected for document generation."
    'Get the path of the document repository where the forms will be found.
    srcPath = FindConstant("Document Repository")
    'Each form generated will be numbered sequentially by calling a static counter function. This resets it.
    GetNextEndorsementNumber reset:=True
    'Iterate over each form, calling a function to replace the keywords and save a copy to the output folder
    For Each cel In Forms.Range(Forms.Cells(2, FormsToGenerateCol), Forms.Cells(1, FormsToGenerateCol).End(xlDown))
        RunReplacements cel.value, CreateDocGenPath(cel.Offset(0, 1).value), oWrd
    Next cel
    oWrd.Quit
    On Error Resume Next
    'Display the folder containing the generated documents
    Call Shell("Explorer.exe " & CreateDocGenPath, vbNormalFocus)
    oWrd.Quit False
    Application.StatusBar = False
    If MsgBox("Policy generation complete. The reserving information will now be recorded.", vbOKCancel, _
              "Policy Generated. OK to store reserving info?") = vbOK Then Push_Reserving_Requirements
    Exit Sub
errmsg:
    MsgBox Err.Description, , "Error generating Policy Documents"
End Sub

Cette routine appelle RunReplacements qui s’occupe de l’ouverture du document, de la préparation de l’environnement pour un remplacement rapide, de la mise à jour des liens une fois celle-ci effectuée, des erreurs de traitement, etc.:

' Purpose: Opens up a document and replaces all instances of special keywords with their respective values.
'          Creates an instance of Word if an existing one is not passed as a parameter.
'          Saves a document to the target path once the template has been filled in.
'
'          Replacements are done using two helper functions, one for doing simple keyword replacements,
'          and one for the more complex replacements like conditional statements and schedules.
Private Sub RunReplacements(ByVal DocumentPath As String, ByVal SaveAsPath As String, _
                            Optional ByRef oWrd As Word.Application = Nothing)
    Dim oDoc As Word.Document
    Dim oWrdGiven As Boolean
    If oWrd Is Nothing Then Set oWrd = New Word.Application Else oWrdGiven = True

    If ERROR_HANDLING Then On Error GoTo docGenError
    oWrd.Visible = False
    oWrd.DisplayAlerts = wdAlertsNone

    Application.StatusBar = "Opening " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
    Set oDoc = oWrd.Documents.Open(Filename:=DocumentPath, Visible:=False)
    RunAdvancedReplacements oDoc
    RunSimpleReplacements oDoc
    UpdateLinks oDoc 'Routine which will update calculated statements in Word (like current date)
    Application.StatusBar = "Saving " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
    oDoc.SaveAs SaveAsPath

    GoTo Finally
docGenError:
    MsgBox "Un unknown error occurred while generating document: " & DocumentPath & vbNewLine _
            & vbNewLine & Err.Description, vbCritical, "Document Generation"
Finally:
    If Not oDoc Is Nothing Then oDoc.Close False: Set oDoc = Nothing
    If Not oWrdGiven Then oWrd.Quit False
End Sub

Cette routine appelle ensuite RunSimpleReplacements. et RunAdvancedReplacements. Dans le premier cas, nous parcourons l'ensemble des mots-clés de génération de document et appelons WordDocReplace si le document contient notre mot-clé. Notez qu'il est beaucoup plus rapide d'essayer Find un tas de mots pour déterminer qu'ils n'existent pas, puis pour appeler indifféremment le remplacement, afin de toujours vérifier si un mot clé existe avant de tenter de le remplacer.

' Purpose: While short, this short module does most of the work with the help of the generation keywords
'          range on the lists sheet. It loops through every simple keyword that might appear in a document
'          and calls a function to have it replaced with the corresponding data from pricing.
Private Sub RunSimpleReplacements(ByRef oDoc As Word.Document)
    Dim DocGenKeys As Range, valueSrc As Range
    Dim value As String
    Dim i As Integer

    Set DocGenKeys = Lists.Range("DocumentGenerationKeywords")
    For i = 1 To DocGenKeys.Rows.Count
        If WordDocContains(oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#") Then
            'Find the text that we will be replacing the placeholder keyword with
            Set valueSrc = Range(Mid(DocGenKeys.Cells(i, 2).Formula, 2))
            If valueSrc.MergeCells Then value = valueSrc.MergeArea.Cells(1, 1).Text Else value = valueSrc.Text
            'Perform the replacement
            WordDocReplace oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#", value
        End If
    Next i
End Sub

C'est la fonction utilisée pour détecter si un mot clé existe dans le document:

' Purpose: Function called for each replacement to first determine as quickly as possible whether
'          the document contains the keyword, and thus whether replacement actions must be taken.
Public Function WordDocContains(ByRef oDoc As Word.Document, ByVal searchFor As String) As Boolean
    Application.StatusBar = "Checking for keyword: " & searchFor
    WordDocContains = False
    Dim storyRange As Word.Range
    For Each storyRange In oDoc.StoryRanges
        With storyRange.Find
            .Text = searchFor
            WordDocContains = WordDocContains Or .Execute
        End With
        If WordDocContains Then Exit For
    Next
End Function

Et c'est là que le caoutchouc rencontre la route - le code qui exécute le remplacement. Cette routine s'est compliquée à mesure que j'ai rencontré des difficultés. Voici les leçons que vous ne retiendrez que de votre expérience:

1. Vous pouvez définir le texte de remplacement directement ou utiliser le Presse-papiers. J'ai découvert à la dure que si vous effectuez un remplacement VBA dans Word à l'aide d'une chaîne de plus de 255 caractères, le texte sera tronqué si vous essayez de le placer dans le Find.Replacement.Text, mais vous pouvez utiliser "^c" comme texte de remplacement, et il sera directement extrait du presse-papiers. C'est la solution que j'ai utilisée.

2. Il vous suffira d'appeler à remplacer les mots-clés manquants dans certaines zones de texte telles que les en-têtes et les pieds de page. Pour cette raison, vous devez en fait parcourir le document.StoryRanges et lancer la recherche et le remplacer sur chacun d'eux pour vous assurer de saisir toutes les occurrences du mot que vous souhaitez remplacer.

3. Si vous définissez directement le Replacement.Text, vous devez convertir les sauts de ligne Excel (vbNewLine et Chr(10)) avec un simple vbCr pour qu'ils apparaissent correctement dans Word. Sinon, partout où votre texte de remplacement comporte des sauts de ligne provenant d'une cellule Excel, des symboles étranges seront insérés dans Word. Si vous utilisez la méthode presse-papiers, vous n'avez pas besoin de le faire, car les sauts de ligne sont convertis automatiquement lorsqu'ils sont placés dans le presse-papiers.

Cela explique tout. Les commentaires devraient être assez clairs aussi. Voici la routine en or qui exécute la magie:

' Purpose: This function actually performs replacements using the Microsoft Word API
Public Sub WordDocReplace(ByRef oDoc As Word.Document, ByVal replaceMe As String, ByVal replaceWith As String)
    Dim clipBoard As New MSForms.DataObject
    Dim storyRange As Word.Range
    Dim tooLong As Boolean

    Application.StatusBar = "Replacing instances of keyword: " & replaceMe

    'We want to use regular search and replace if we can. It's faster and preserves the formatting that
    'the keyword being replaced held (like bold).  If the string is longer than 255 chars though, the
    'standard replace method doesn't work, and so we must use the clipboard method (^c special character),
    'which does not preserve formatting. This is alright for schedules though, which are always plain text.
    If Len(replaceWith) > 255 Then tooLong = True
    If tooLong Then
        clipBoard.SetText IIf(replaceWith = vbNullString, "", replaceWith)
        clipBoard.PutInClipboard
    Else
        'Convert Excel in-cell line breaks to Word line breaks. (Not necessary if using clipboard)
        replaceWith = Replace(replaceWith, vbNewLine, vbCr)
        replaceWith = Replace(replaceWith, Chr(10), vbCr)
    End If
    'Replacement must be done on multiple 'StoryRanges'. Unfortunately, simply calling replace will miss
    'keywords in some text areas like headers and footers.
    For Each storyRange In oDoc.StoryRanges
        Do
            With storyRange.Find
                .MatchWildcards = True
                .Text = replaceMe
                .Replacement.Text = IIf(tooLong, "^c", replaceWith)
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
            On Error Resume Next
            Set storyRange = storyRange.NextStoryRange
            On Error GoTo 0
        Loop While Not storyRange Is Nothing
    Next
    If tooLong Then clipBoard.SetText ""
    If tooLong Then clipBoard.PutInClipboard
End Sub

Une fois la poussière retombée, il nous reste une belle version du document initial avec les valeurs de production à la place de ces mots-clés marqués avec hachage. J'aimerais montrer un exemple, mais chaque document rempli contient évidemment des informations exclusives.

---

Je pense que la seule chose qui reste à mentionner serait la section RunAdvancedReplacements. Il fait quelque chose d'extrêmement similaire - il finit par appeler la même fonction WordDocReplace, mais la particularité des mots clés utilisés ici est qu'ils ne sont pas liés à une seule cellule du classeur d'origine, ils sont générés dans le code. derrière des listes dans le classeur. Ainsi, par exemple, un des remplacements avancés ressemblerait à ceci:

'Generate the schedule of vessels
If WordDocContains(oDoc, "#VESSELSCHEDULE#") Then _
    WordDocReplace oDoc, "#VESSELSCHEDULE#", GenerateVesselSchedule()

Et ensuite, il y aura une routine correspondante qui assemblera une chaîne contenant toutes les informations sur le navire telles que configurées par l'utilisateur:

' Purpose: Generates the list of vessels from the "Vessels" sheet based on the user's configuration
'          in the booking tab. The user has the option to generate one or both of Owned Vessels
'          and Chartered Vessels, as well as what fields to display. Uses a helper function.
Public Function GenerateVesselSchedule() As String
    Dim value As String

    Application.StatusBar = "Generating Schedule of Vessels."
    If Booking.Range("ListVessels").value = "Yes" Then
        Dim VesselCount As Long

        If Booking.Range("ListVessels").Offset(1).value = "Yes" Then _
            value = value & GenerateVesselScheduleHelper("Vessels", VesselCount)
        If Booking.Range("ListVessels").Offset(1).value = "Yes" And _
           Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
            value = value & "(Chartered Vessels)" & vbNewLine
        If Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
            value = value & GenerateVesselScheduleHelper("CharteredVessels", VesselCount)
        If Len(value) > 2 Then value = Left(value, Len(value) - 2) 'Remove the trailing line break
    Else
        GenerateVesselSchedule = Booking.Range("VesselSchedAlternateText").Text
    End If
    GenerateVesselSchedule = value
End Function

' Purpose: Helper function for the Vessel Schedule generation routine. Generates either the Owned or
'          Chartered vessels based on the schedule parameter passed. The list is numbered and contains
'          the information selected by the user on the Booking sheet.
' SENSITIVE: Note that this routine is sensitive to the layout of the Vessel Schedule tab and the
'            parameters on the Configure Quotes tab. If either changes, it should be revisited.
Public Function GenerateVesselScheduleHelper(ByVal schedule As String, ByRef VesselCount As Long) As String
    Dim value As String, nextline As String
    Dim numInfo As Long, iRow As Long, iCol As Long
    Dim Inclusions() As Boolean, Columns() As Long

    'Gather info about vessel info to display in the schedule
    With Booking.Range("VesselInfoToInclude")
        numInfo = Booking.Range(.Cells(1, 1), .End(xlToRight)).Columns.Count - 1
        ReDim Inclusions(1 To numInfo)
        ReDim Columns(1 To numInfo)
        On Error Resume Next 'Some columns won't be identified
        For iCol = 1 To numInfo
            Inclusions(iCol) = .Offset(0, iCol) = "Yes"
            Columns(iCol) = sumSchedVessels.Range(schedule).Cells(1).EntireRow.Find(.Offset(-1, iCol)).Column
        Next iCol
        On Error GoTo 0
    End With

    'Build the schedule
    With sumSchedVessels.Range(schedule)
        For iRow = .row + 1 To .row + .Rows.Count - 1
            If Len(sumSchedVessels.Cells(iRow, Columns(1)).value) > 0 Then
                VesselCount = VesselCount + 1
                value = value & VesselCount & "." & vbTab
                nextline = vbNullString
                'Add each property that was included to the description string
                If Inclusions(1) Then nextline = nextline & sumSchedVessels.Cells(iRow, Columns(1)) & vbTab
                If Inclusions(2) Then nextline = nextline & "Built: " & sumSchedVessels.Cells(iRow, Columns(2)) & vbTab
                If Inclusions(3) Then nextline = nextline & "Length: " & _
                                      Format(sumSchedVessels.Cells(iRow, Columns(3)), "#'") & vbTab
                If Inclusions(4) Then nextline = nextline & "" & sumSchedVessels.Cells(iRow, Columns(4)) & vbTab
                If Inclusions(5) Then nextline = nextline & "Hull Value: " & _
                                      Format(sumSchedVessels.Cells(iRow, Columns(5)), "$#,##0") & vbTab
                If Inclusions(6) Then nextline = nextline & "IV: " & _
                                      Format(sumSchedVessels.Cells(iRow, Columns(6)), "$#,##0") & vbTab
                If Inclusions(7) Then nextline = nextline & "TIV: " & _
                                      Format(sumSchedVessels.Cells(iRow, Columns(7)), "$#,##0") & vbTab
                If Inclusions(8) And schedule = "CharteredVessels" Then _
                    nextline = nextline & "Deductible: " & Format(bmCharterers.Range(schedule).Cells( _
                               iRow - .row, 9), "$#,##0") & vbTab
                nextline = Left(nextline, Len(nextline) - 1) 'Remove the trailing tab
                'If more than 4 properties were included insert a new line after the 4th one
                Dim tabloc As Long: tabloc = 0
                Dim counter As Long: counter = 0
                Do
                    tabloc = tabloc + 1
                    tabloc = InStr(tabloc, nextline, vbTab)
                    If tabloc > 0 Then counter = counter + 1
                Loop While tabloc > 0 And counter < 4
                If counter = 4 Then nextline = Left(nextline, tabloc - 1) & vbNewLine & Mid(nextline, tabloc)
                value = value & nextline & vbNewLine
            End If
        Next iRow
    End With

    GenerateVesselScheduleHelper = value
End Function

la chaîne résultante peut être utilisée comme le contenu de toute cellule Excel et transmise à la fonction de remplacement, qui utilisera la méthode presse-papier de manière appropriée si elle dépasse 255 caractères.

Donc ce template:

Plus ces données de tableur:

Devient ce document:

---

J'espère sincèrement que cela aidera quelqu'un un jour. C’était définitivement une entreprise gigantesque et une roue complexe à réinventer. L’application est énorme, avec plus de 50 000 lignes de code VBA, donc si j’ai référencé une méthode cruciale dans mon code là où quelqu'un a besoin, veuillez laisser un commentaire et je l’ajouterai ici.

Answer 2

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Décrit l'utilisation de Word bookmarks

Une section de texte dans un document peut être mise en signet} _ et recevoir un nom de variable. En utilisant VBA, cette variable est accessible et le contenu du document peut être remplacé par un autre contenu. C'est une solution pour avoir des espaces réservés tels que Nom et Adresse dans le document.

De plus, en utilisant des signets, les documents peuvent être modifiés pour référencer du texte marqué. Si un nom apparaît plusieurs fois dans un document, vous pouvez créer un signet pour la première instance et faire référence au signet par des instances supplémentaires. Désormais, lorsque la première instance est modifiée par programme, toutes les autres instances de la variable dans le document sont également modifiées automatiquement.

Désormais, il ne vous reste plus qu'à mettre à jour tous les documents en y ajoutant le texte de substitution et en utilisant une convention de dénomination cohérente, puis parcourez chaque document en remplaçant le signet, le cas échéant:

document.Bookmarks("myBookmark").Range.Text = "Inserted Text"

Je peux probablement résoudre le problème des variables qui n'apparaissent pas dans un document donné à l'aide de la clause on error resume next avant de tenter chaque remplacement.

Merci à Doug Glancy d’avoir mentionné l’existence de signets dans son commentaire. Je n'avais aucune connaissance de leur existence auparavant. Je garderai ce sujet à jour pour savoir si cette solution est suffisante.

Answer 3

Vous pourriez envisager une approche basée sur XML.

Word possède une fonctionnalité appelée liaison de données XML personnalisée ou contrôles de contenu liés aux données. Un contrôle de contenu est essentiellement un point du document pouvant contenir du contenu. Un contrôle de contenu "lié aux données" extrait son contenu d'un document XML que vous incluez dans le fichier zip docx. Une expression XPath est utilisée pour dire quel bit de XML. Donc, tout ce que vous avez à faire est d’inclure votre fichier XML et Word fera le reste.

Excel dispose de moyens pour extraire les données au format XML. La solution dans son ensemble devrait donc fonctionner correctement.

Il existe de nombreuses informations sur la liaison des données de contrôle du contenu sur MSDN (certaines d'entre elles ont déjà été référencées dans des questions SO précédentes), je ne vais donc pas les inclure ici.

Mais vous avez besoin d'un moyen de configurer les fixations. Vous pouvez utiliser Content Control Toolkit ou mon complément OpenDoPE à partir de Word.

Answer 4

Ayant effectué une tâche similaire, j'ai constaté que l'insertion de valeurs dans les tables était beaucoup plus rapide que la recherche de balises nommées - les données peuvent ensuite être insérées comme suit:

    With oDoc.Tables(5)
    For i = 0 To Data.InvoiceDictionary.Count - 1
        If i > 0 Then
            oDoc.Tables(5).rows.Add
        End If
         Set invoice = Data.InvoiceDictionary.Items(i)
        .Cell(i + 2, 1).Range.Text = invoice.InvoiceCCNumber
        .Cell(i + 2, 2).Range.Text = invoice.InvoiceDate
        .Cell(i + 2, 3).Range.Text = invoice.TransactionType
        .Cell(i + 2, 4).Range.Text = invoice.Description
        .Cell(i + 2, 5).Range.Text = invoice.SumOfValue

    Next i

.Cell (i + 1, 4) .Range.Text = "Total:" Terminer pardans ce cas, la rangée 1 du tableau correspond aux en-têtes; la ligne 2 était vide et il n'y avait plus de lignes - ainsi, le fichier rows.add s'applique une fois, plus d'une ligne a été attachée. Les tableaux peuvent être des documents très détaillés et en masquant les bordures, les bordures de cellules peuvent ressembler à du texte ordinaire. Les tableaux sont numérotés séquentiellement après le flux de documents. (i.e. Doc.Tables (1) est la première table ...