para - Genere documentos de Word(en Excel VBA) a partir de una serie de plantillas de documentos

numeracion automatica en excel

Question

Oigan todos. Intentaré hacer esto breve y simple. :)

yo tengo

1. 40 o más documentos de Word con una serie de campos (nombre, dirección, etc.) que deben completarse. Esto se hace manualmente de forma manual, pero es repetitivo y engorroso.
2. Un libro de trabajo donde un usuario ha llenado una gran cantidad de información sobre un individuo.

Necesito

• Una forma de programar (desde Excel VBA) abrir estos documentos de plantilla, editar el valor de los campos de varios rangos con nombre en el libro de trabajo y guardar las plantillas completadas en una carpeta local.

Si utilizara VBA para editar de manera programada valores particulares en un conjunto de hojas de cálculo, editaría todas esas hojas de cálculo para contener un conjunto de rangos con nombre que podrían usarse durante el proceso de llenado automático, pero no conozco ningún campo ''característica en un documento de Word.

¿Cómo podría editar los documentos y crear una rutina de VBA para poder abrir cada documento, buscar un conjunto de campos que deban completarse y sustituir un valor?

Por ejemplo, algo que funciona como:

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

Cosas que he considerado:

• Combinación de correspondencia, pero esto no es suficiente porque requiere abrir cada documento manualmente y estructurar el libro de trabajo como una fuente de datos, quiero lo contrario. Las plantillas son la fuente de datos y el libro de trabajo está iterando a través de ellas. Además, la combinación de correspondencia sirve para crear muchos documentos idénticos utilizando una tabla de datos diferentes. Tengo muchos documentos todos usando los mismos datos.
• Usar texto de marcador de posición como "# NAME #" y abrir cada documento para una búsqueda y reemplazo. Esta es la solución a la que recurriría si no se propone nada más elegante.

Answer 1

Después de haber realizado una tarea similar, descubrí que insertar valores en las tablas era mucho más rápido que buscar etiquetas con nombre; los datos se pueden insertar de esta forma:

    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:" Fin con En este caso, la fila 1 de la tabla fue los encabezados; la fila 2 estaba vacía y no había más filas, por lo tanto, row.add se aplica una vez que se adjuntó más de una fila. Las tablas pueden ser documentos muy detallados y al ocultar los bordes y los bordes de las celdas se puede hacer que se vea como texto ordinario. Las tablas se numeran secuencialmente siguiendo el flujo del documento. (ie Doc.Tables (1) es la primera tabla ...

Answer 2

Ha pasado mucho tiempo desde que hice esta pregunta, y mi solución ha sido refinada cada vez más. He tenido que lidiar con todo tipo de casos especiales, como los valores que provienen directamente del libro de trabajo, las secciones que deben generarse especialmente en función de las listas y la necesidad de hacer reemplazos en los encabezados y pies de página.

Como resultado, no fue suficiente usar marcadores, ya que fue posible que los usuarios posteriormente editaran documentos para cambiar, agregar y eliminar valores de marcador de posición de los documentos. De hecho, la solución fue utilizar palabras clave como esta:

Esto es solo una página de un documento de muestra que utiliza algunos de los valores posibles que pueden insertarse automáticamente en un documento. Existen más de 50 documentos con estructuras y diseños completamente diferentes, y con diferentes parámetros. El único conocimiento común compartido por los documentos de Word y la hoja de cálculo de Excel es un conocimiento de lo que se supone que representan estos valores de marcador de posición. En Excel, esto se almacena en una lista de palabras clave de generación de documentos, que contienen la palabra clave, seguida de una referencia al rango que realmente contiene este valor:

Estos fueron los dos ingredientes clave requeridos. Ahora, con un código inteligente, todo lo que tenía que hacer era iterar sobre cada documento que se generaría, y luego iterar sobre el rango de todas las palabras clave conocidas, y hacer una búsqueda y reemplazar cada palabra clave en cada documento.

Primero, tengo el método de envoltura, que se encarga de mantener una instancia de Microsoft Word iterando sobre todos los documentos seleccionados para la generación, numerando los documentos y haciendo las cosas de la interfaz del usuario (como el manejo de errores, mostrar la carpeta al usuario, 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

Esa rutina llama a RunReplacements que se encarga de abrir el documento, preparar el entorno para un reemplazo rápido, actualizar los enlaces una vez hecho, manejar los errores, 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

Esa rutina entonces invoca a RunSimpleReplacements . y RunAdvancedReplacements . En el primero, iteramos sobre el conjunto de palabras clave de generación de documentos y llamamos a WordDocReplace si el documento contiene nuestra palabra clave. Tenga en cuenta que es mucho más rápido tratar de Find un montón de palabras para darse cuenta de que no existen, luego llamar a reemplazar indiscriminadamente, por lo que siempre verificamos si existe una palabra clave antes de intentar reemplazarla.

'' 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

Esta es la función utilizada para detectar si existe una palabra clave en el 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

Y aquí es donde el caucho se encuentra con el camino, el código que ejecuta el reemplazo. Esta rutina se hizo más complicada ya que encontré dificultades. Aquí están las lecciones que solo aprenderás de la experiencia:

1. Puede establecer el texto de reemplazo directamente o puede usar el portapapeles. Descubrí de la manera más difícil que si está haciendo una sustitución de VBA en una palabra con una cadena de más de 255 caracteres, el texto se truncará si trata de colocarlo en el texto de Find.Replacement.Text , pero puede usar "^c" como texto de reemplazo, y lo obtendrá directamente del portapapeles. Esta fue la solución que pude usar.

2. Simplemente llamando a reemplazar se perderán las palabras clave en algunas áreas de texto como encabezados y pies de página. Debido a esto, realmente necesita recorrer en iteración el document.StoryRanges Cambie los intervalos y ejecute la búsqueda y el reemplazo en cada uno para asegurarse de capturar todas las instancias de la palabra que desea reemplazar.

3. Si está configurando el Replacement.Text directamente, necesita convertir los saltos de línea de Excel ( vbNewLine y Chr(10) ) con un vbCr simple para que aparezcan correctamente en Word. De lo contrario, en cualquier lugar donde el texto de reemplazo tenga saltos de línea provenientes de una celda de Excel, se terminará insertando símbolos extraños en la palabra. Sin embargo, si usa el método del portapapeles, no necesita hacerlo, ya que los saltos de línea se convierten automáticamente cuando se colocan en el portapapeles.

Eso lo explica todo. Los comentarios deben ser bastante claros también. Aquí está la rutina de oro que ejecuta 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

Cuando el polvo se asienta, nos quedamos con una hermosa versión del documento inicial con valores de producción en lugar de esas palabras clave marcadas con hash. Me encantaría mostrar un ejemplo, pero, por supuesto, cada documento completo contiene información de propiedad exclusiva.

Lo único que me queda por mencionar, supongo, sería en la sección de RunAdvancedReplacements . Hace algo extremadamente similar: termina llamando a la misma función WordDocReplace , pero lo especial de las palabras clave utilizadas aquí es que no se vinculan a una sola celda en el libro de trabajo original, se generan en el código subyacente a partir de listas en el cuaderno de ejercicios Entonces, por ejemplo, uno de los reemplazos avanzados se vería así:

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

Y luego habrá una rutina correspondiente que reúne una cadena que contiene toda la información del barco según lo configurado por el usuario:

'' 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 cadena resultante se puede usar como el contenido de cualquier celda de Excel y se puede pasar a la función de reemplazo, que utilizará adecuadamente el método del portapapeles si supera los 255 caracteres.

Así que esta plantilla:

Más los datos de esta hoja de cálculo:

Se convierte en este documento:

Espero sinceramente que esto ayude a alguien algún día. Definitivamente era una empresa enorme y una rueda compleja tener que reinventar. La aplicación es enorme, con más de 50,000 líneas de código VBA, así que si he hecho referencia a un método crucial en mi código en algún lugar que alguien necesite, deje un comentario y lo agregaré aquí.

Answer 3

Podría considerar un enfoque basado en XML.

Word tiene una función llamada enlace de datos XML personalizado o controles de contenido enlazados a datos. Un control de contenido es esencialmente un punto en el documento que puede contener contenido. Un control de contenido "enlazado a datos" obtiene su contenido de un documento XML que incluye en el archivo zip docx. Una expresión XPath se usa para decir qué bit de XML. Así que todo lo que necesita hacer es incluir su archivo XML, y Word hará el resto.

Excel tiene formas de obtener datos como XML, por lo que toda la solución debería funcionar bien.

Hay mucha información sobre el enlace de datos de control de contenido en MSDN (parte de la cual se ha mencionado en preguntas anteriores de SO), por lo que no me molestaré en incluirlos aquí.

Pero necesitas una forma de configurar los enlaces. Puede usar el kit de herramientas de control de contenido, o si desea hacerlo desde Word, mi complemento OpenDoPE.

Answer 4

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Describe el uso de marcadores de Word

Una sección de texto en un documento se puede marcar como favorito y se le puede asignar un nombre de variable. Al usar VBA, se puede acceder a esta variable y el contenido del documento se puede reemplazar con contenido alternativo. Esta es una solución para tener marcadores de posición como Nombre y Dirección en el documento.

Además, utilizando marcadores, los documentos pueden modificarse para hacer referencia al texto marcado. Si un nombre aparece varias veces a lo largo de un documento, la primera instancia se puede marcar como favorito, y las instancias adicionales pueden hacer referencia al marcador. Ahora, cuando la primera instancia se cambia programáticamente, todas las demás instancias de la variable en todo el documento también se cambian automáticamente.

Ahora todo lo que se necesita es actualizar todos los documentos marcando el texto del marcador de posición y utilizando una convención de nomenclatura coherente en todos los documentos, luego iterar a través de cada documento reemplazando el marcador si existe:

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

Probablemente pueda resolver el problema de las variables que no aparecen en un documento dado utilizando la siguiente cláusula sobre el error reanudar antes de intentar cada reemplazo.

Gracias a Doug Glancy por mencionar la existencia de marcadores en su comentario. No tenía conocimiento de su existencia de antemano. Mantendré este tema publicado sobre si esta solución es suficiente.