it-swarm.dev

Genera documenti Word (in VBA Excel) da una serie di modelli di documento

Ciao a tutti. Proverò a rendere questo breve e semplice. :)

Io ho

  1. 40 o più documenti Word con una serie di campi (nome, indirizzo, ecc.) Che devono essere compilati. Questo viene fatto storicamente manualmente, ma è ripetitivo ed ingombrante.
  2. Una cartella di lavoro in cui un utente ha riempito un enorme set di informazioni su un individuo.

Ho bisogno

  • Un modo per programmare (da Excel VBA) aprire questi documenti standard, modificare il valore dei campi da vari intervalli denominati nella cartella di lavoro e salvare i modelli compilati in una cartella locale.

Se usassi VBA per modificare in modo programmatico determinati valori in una serie di fogli di lavoro, modificherei tutti quei fogli di calcolo per contenere un insieme di intervalli denominati che potrebbero essere utilizzati durante il processo di auto-riempimento, ma non sono a conoscenza di alcun 'nome campo 'funzione in un documento di Word.

Come posso modificare i documenti e creare una routine VBA, in modo che possa aprire ciascun documento, cercare un insieme di campi che potrebbero dover essere compilati e sostituire un valore?

Ad esempio, qualcosa che funziona come:

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

Cose che ho considerato:

  • Stampa unione - ma questo non è sufficiente perché richiede l'apertura manuale di ogni documento e la strutturazione della cartella di lavoro come origine dati, desidero il contrario. I modelli sono l'origine dati e la cartella di lavoro sta iterando attraverso di essi. Inoltre, la stampa unione consente di creare molti documenti identici utilizzando una tabella di dati diversi. Ho molti documenti che usano tutti gli stessi dati.
  • Usando il testo segnaposto come "# NOME #" e aprendo ogni documento per una ricerca e sostituirlo. Questa è la soluzione a cui ricorrere se non viene proposto nulla di più elegante.
20
Alain

È passato molto tempo da quando ho fatto questa domanda e la mia soluzione ha subito sempre più affinamenti. Ho dovuto trattare tutti i tipi di casi speciali, come i valori che provengono direttamente dalla cartella di lavoro, le sezioni che devono essere generate in modo particolare in base agli elenchi e la necessità di eseguire sostituzioni nelle intestazioni e nei piè di pagina.

A quanto pare, non è stato sufficiente utilizzare i segnalibri, poiché gli utenti potevano modificare in seguito i documenti per modificare, aggiungere e rimuovere i valori segnaposto dai documenti. La soluzione era infatti usare keywords come questo:

enter image description here

Questa è solo una pagina di un documento di esempio che utilizza alcuni dei possibili valori che possono essere inseriti automaticamente in un documento. Oltre 50 documenti esistono con strutture e layout completamente diversi e utilizzano parametri diversi. L'unica conoscenza comune condivisa dai documenti di Word e dal foglio di calcolo di Excel è la conoscenza di ciò che questi valori segnaposto sono destinati a rappresentare. In Excel, questo è memorizzato in un elenco di parole chiave di generazione di documenti, che contengono la parola chiave, seguito da un riferimento all'intervallo che contiene effettivamente questo valore:

enter image description here

Questi erano i due ingredienti chiave richiesti. Ora con un codice intelligente, tutto ciò che dovevo fare era iterare su ogni documento da generare, quindi scorrere l'intervallo di tutte le parole chiave conosciute e fare una ricerca e sostituzione per ogni parola chiave in ogni documento.


Innanzitutto, ho il metodo wrapper, che si occupa di mantenere un'istanza di Microsoft Word che itera su tutti i documenti selezionati per la generazione, numerare i documenti e fare le cose dell'interfaccia utente (come gestire errori, visualizzare la cartella all'utente, ecc. )

' 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

Quella routine chiama RunReplacements che si occupa di aprire il documento, preparare l'ambiente per una rapida sostituzione, aggiornare i collegamenti una volta eseguiti, gestire gli errori, ecc.

' 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

Quella routine quindi richiama RunSimpleReplacements. e RunAdvancedReplacements. Nel primo caso, iteriamo sull'insieme delle parole chiave per la generazione di documenti e chiamiamo WordDocReplace se il documento contiene la nostra parola chiave. Si noti che è molto più veloce provare e Find un gruppo di parole per capire che non esistono, quindi chiamare la sostituzione indiscriminatamente, quindi controlliamo sempre se esiste una parola chiave prima di tentare di sostituirla.

' 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

Questa è la funzione utilizzata per rilevare se esiste una parola chiave nel documento: 

' 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

Ed è qui che la gomma incontra la strada: il codice che esegue la sostituzione. Questa routine è diventata più complicata quando ho incontrato difficoltà. Ecco le lezioni che imparerai solo dall'esperienza:

  1. È possibile impostare direttamente il testo sostitutivo oppure è possibile utilizzare gli Appunti. Ho scoperto che se si esegue una sostituzione VBA in Word utilizzando una stringa più lunga di 255 caratteri, il testo verrà troncato se si tenta di inserirlo in Find.Replacement.Text, ma è possibile utilizzare "^c" come testo sostitutivo e lo otterrà direttamente dagli appunti. Questa era la soluzione che dovevo usare.

  2. Semplicemente chiamando la sostituzione mancherà le parole chiave in alcune aree di testo come intestazioni e piè di pagina. Per questo motivo, devi effettivamente eseguire iterate su document.StoryRanges ed eseguire la ricerca e sostituirle su ciascuna per assicurarti di catturare tutte le istanze del Word che desideri sostituire.

  3. Se si imposta direttamente Replacement.Text, è necessario convertire le interruzioni di riga di Excel (vbNewLine e Chr(10)) con un semplice vbCr affinché appaiano correttamente in Word. In caso contrario, dovunque il testo sostitutivo presenti interruzioni di linea provenienti da una cella di Excel finirà per inserire strani simboli in Word. Tuttavia, se si utilizza il metodo degli appunti, non è necessario eseguire questa operazione, poiché le interruzioni di riga vengono convertite automaticamente quando inserite negli Appunti.

Questo spiega tutto. Anche i commenti dovrebbero essere abbastanza chiari. Ecco la routine d'oro che esegue la magia:

' 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

Quando la polvere si deposita, ci rimane una bella versione del documento iniziale con i valori di produzione al posto di quelle parole chiave segnate con hash. Mi piacerebbe mostrare un esempio, ma ovviamente ogni documento inserito contiene informazioni di proprietà esclusiva.


L'unica cosa che rimane da menzionare suppongo sia quella sezione RunAdvancedReplacements. Fa qualcosa di estremamente simile - finisce per chiamare la stessa funzione WordDocReplace, ma la particolarità delle parole chiave usate qui è che non si collegano a una singola cella nella cartella di lavoro originale, vengono generate nel code-behind dagli elenchi in la cartella di lavoro. Quindi, ad esempio, una delle sostituzioni avanzate sarebbe simile a questa:

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

E poi ci sarà una routine corrispondente che mette assieme una stringa contenente tutte le informazioni sulla nave configurate dall'utente:

' 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 stringa risultante può essere utilizzata proprio come il contenuto di qualsiasi cella di Excel e passata alla funzione di sostituzione, che utilizzerà appropriatamente il metodo degli appunti se supera i 255 caratteri. 

Quindi questo modello:

enter image description here

Oltre a questi dati del foglio di calcolo:

enter image description here

Diventa questo documento:

enter image description here


Spero sinceramente che questo aiuti qualcuno fuori un giorno. È stata sicuramente una grande impresa e una ruota complessa da reinventare. L'applicazione è enorme, con oltre 50.000 righe di codice VBA, quindi se ho fatto riferimento a un metodo cruciale nel mio codice da qualche parte che qualcuno ha bisogno, si prega di lasciare un commento e lo aggiungerò qui.

29
Alain

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Descrive l'uso di Word bookmarks

Una sezione di testo in un documento può essere segnalibro e ha un nome variabile. Utilizzando VBA, è possibile accedere a questa variabile e il contenuto del documento può essere sostituito con contenuti alternativi. Questa è una soluzione per avere segnaposto come Nome e Indirizzo nel documento.

Inoltre, utilizzando i segnalibri, i documenti possono essere modificati per fare riferimento al testo del segnalibro. Se un nome appare più volte in un documento, la prima istanza può essere aggiunta ai segnalibri e le istanze aggiuntive possono fare riferimento al segnalibro. Ora, quando la prima istanza viene modificata in modo programmatico, anche tutte le altre istanze della variabile in tutto il documento vengono automaticamente modificate.

Ora tutto ciò che serve è aggiornare tutti i documenti contrassegnando il testo segnaposto e utilizzando una convenzione di denominazione coerente in tutti i documenti, quindi scorrere ogni documento sostituendo il segnalibro se esiste:

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

Posso probabilmente risolvere il problema delle variabili che non compaiono in un dato documento usando la clausola on resume next next prima di tentare ogni sostituzione.

Grazie a Doug Glancy per aver menzionato l'esistenza di segnalibri nel suo commento. Non avevo conoscenza della loro esistenza in anticipo. Terrò questo argomento pubblicato se questa soluzione è sufficiente.

3
Alain

Potresti considerare un approccio basato su XML.

Word ha una funzionalità denominata Associazione dati XML personalizzati o controlli del contenuto con associazione a dati. Un controllo del contenuto è essenzialmente un punto nel documento che può contenere contenuto. Un controllo contenuto "con associazione a dati" ottiene il suo contenuto da un documento XML incluso nel file zip docx. Un'espressione XPath è usata per dire quale bit di XML. Quindi tutto ciò che devi fare è includere il tuo file XML, e Word farà il resto.

Excel ha il modo di estrarre i dati come XML, quindi l'intera soluzione dovrebbe funzionare bene.

Vi sono molte informazioni sul controllo dei dati che vincolano i dati su MSDN (alcuni dei quali sono stati citati in precedenti SO domande) quindi non mi preoccuperò di includerli qui.

Ma hai bisogno di un modo per impostare i binding. È possibile utilizzare Content Control Toolkit o, se si desidera farlo, da Word, il mio componente aggiuntivo OpenDoPE.

2
JasonPlutext

Avendo svolto un compito simile, ho scoperto che l'inserimento di valori nelle tabelle era molto più rapido rispetto alla ricerca di tag con nome: i dati possono quindi essere inseriti in questo modo:

    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 = "Totale:" Fine Con In questo caso la riga 1 del tavolo era intestata; la riga 2 era vuota e non c'erano altre righe, quindi il file rows.add si applica una volta più di una riga collegata. Le tabelle possono essere documenti molto dettagliati e nascondendo i bordi e i bordi delle celle possono essere fatti apparire come un normale testo. Le tabelle sono numerate in sequenza seguendo il flusso del documento. (Ad esempio Doc.Tables (1) è la prima tabella ... 

0
Simon N