일련의 문서 템플릿에서 Word 문서 생성(Excel VBA)

일련의 문서 템플릿에서 Word 문서 생성(Excel VBA)

여러분.간결하고 간단하게 하도록 하겠습니다.:)

있습니다

1. 기입할 필요가 있는 일련의 필드(이름, 주소 등)가 있는 40여 개의 상용어 문서.이전에는 수동으로 이루어졌지만 반복적이고 번거롭습니다.
2. 사용자가 개인에 대한 방대한 정보를 채운 워크북입니다.

필요합니다

• 프로그래밍 방식으로(Excel VBA에서) 이러한 보일러 플레이트 문서를 열고, 워크북의 다양한 명명된 범위의 필드 값을 편집하고, 채워진 템플릿을 로컬 폴더에 저장하는 방법입니다.

VBA를 사용하여 스프레드시트 세트의 특정 값을 프로그래밍 방식으로 편집하는 경우 자동 입력 프로세스에서 사용할 수 있는 일련의 명명된 범위를 포함하도록 모든 스프레드시트를 편집하지만 Word 문서에서 '이름 있는 필드' 기능은 인식하지 못합니다.

문서를 편집하고 VBA 루틴을 생성하여 각 문서를 열고 입력해야 할 필드 세트를 찾고 값을 대체하려면 어떻게 해야 합니까?

예를 들어 다음과 같은 기능이 있습니다.

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

내가 생각한 것:

• 메일 병합 - 그러나 각 문서를 수동으로 열고 워크북을 데이터 소스로 구성해야 하므로 충분하지 않습니다. 그 반대도 원합니다.템플릿은 데이터 소스이며 워크북은 템플릿을 통해 반복됩니다.또한 메일 병합은 서로 다른 데이터의 표를 사용하여 동일한 문서를 많이 만들기 위한 것입니다.저는 모두 같은 데이터를 사용하여 많은 문서를 가지고 있습니다.
• "#NAME#"과 같은 플레이스홀더 텍스트를 사용하고 검색 및 치환을 위해 각 문서를 엽니다.이것이 더 이상 우아한 제안이 없다면 내가 의지할 해결책이다.

이 질문을 한 지 오래되었고, 저의 해결책은 점점 더 정교해졌습니다.워크북에서 직접 가져온 값, 목록을 기반으로 특별히 생성해야 하는 섹션, 머리글과 바닥글을 교체해야 하는 등 모든 종류의 특별한 경우에 대처해야 했습니다.

나중에 사용자가 문서를 편집하여 플레이스홀더 값을 변경, 추가 및 삭제할 수 있기 때문에 북마크를 사용하는 것만으로는 충분하지 않았습니다.해결책은 다음과 같은 키워드를 사용하는 것이었습니다.

이것은 문서에 자동으로 삽입될 수 있는 가능한 값 중 일부를 사용하는 샘플 문서의 페이지입니다.50개 이상의 문서가 완전히 다른 구조와 레이아웃을 가지며 서로 다른 매개변수를 사용합니다.문서라는 단어와 Excel 스프레드시트가 공유하는 유일한 공통 지식은 이러한 자리 표시자 값이 무엇을 나타내는지에 대한 지식입니다.Excel에서는 이 키워드가 포함된 문서 생성 키워드 목록과 실제 이 값을 포함하는 범위에 대한 참조가 저장됩니다.

이것들은 필요한 두 가지 핵심 재료였다.이제 몇 가지 현명한 코드를 사용하여 생성할 각 문서에 대해 반복하고 모든 알려진 키워드 범위를 반복하여 각 문서의 각 키워드를 검색 및 치환하기만 하면 됩니다.

---

우선, 생성용으로 선택된 모든 문서에 대해 마이크로소프트 워드의 반복 인스턴스를 유지하고, 문서에 번호를 매기고, 사용자 인터페이스 작업(오류 처리, 사용자에게 폴더 표시 등)을 수행하는 래퍼 방법이 있습니다.

' 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

루틴은 「」를 호출합니다.RunReplacements, 링크 오류 문서 열기, 링크 업데이트, 오류 처리.

' 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

다음 이 이 호출됩니다.RunSimpleReplacements .는.RunAdvancedReplacements Document 하여 에 문의합니다.WordDocReplace문서에 키워드가 포함되어 있는지 확인합니다. 해서 해보는 게예요.Find존재하지 않는 단어를 알아내서 무차별적으로 치환이라고 부르기 때문에 치환을 시도하기 전에 항상 키워드가 존재하는지 확인합니다.

' 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

다음 함수는 문서에 키워드가 존재하는지 여부를 검출하기 위해 사용됩니다.

' 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

그리고 여기서 고무와 도로의 교체가 이루어지는 코드입니다.이 일은 내가 어려움을 겪으면서 더 복잡해졌다.다음은 경험을 통해서만 배울 수 있는 교훈입니다.

1. 대체 텍스트를 직접 설정하거나 클립보드를 사용할 수 있습니다.을 하는 255자 .Find.Replacement.Text , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ."^c"클립보드에서 직접 가져옵니다.이것이 제가 사용할 수 있는 회피책이었습니다.

2. 단순히 replace를 호출하는 것만으로 헤더나 바닥글과 같은 일부 텍스트 영역에서 키워드가 누락됩니다. 때문에 '아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아,아document.StoryRanges각 단어에 대해 검색 및 치환을 실행하여 바꿀 단어의 모든 인스턴스를 검색하도록 합니다.

3. ' the the the를 하고 있다면,Replacement.Text바꿈을 변환해야 (Excel 줄 바꿈).vbNewLine ★★★★★★★★★★★★★★★★★」Chr(10)와 심플한 」를 병용합니다.vbCr줄단어에 하게 됩니다.그렇지 않으면 대체 텍스트의 줄 바꿈이 Excel 셀에서 나오는 경우 단어에 이상한 기호를 삽입하게 됩니다.그러나 클립보드에 넣을 때 줄 바꿈이 자동으로 변환되므로 클립보드 방법을 사용할 필요가 없습니다.

그래서 모든 게 설명이 되네요.댓글도 꽤 명확해야 합니다.여기 마법을 실행하는 황금 루틴이 있습니다.

' 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

사태가 진정되면 해시 마크된 키워드 대신 생산 가치가 있는 아름다운 버전의 초기 문서가 남게 됩니다.예를 들어 보여드리고 싶지만, 물론 모든 문서에는 독점 정보가 포함되어 있습니다.

---

말할 수 있는 유일한 은 '아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아, 아...RunAdvancedReplacements아주 . 것을 됩니다.을 사용하다WordDocReplace여기서 사용되는 키워드의 특별한 점은 원래 워크북의 단일 셀에 링크되지 않고 워크북의 목록에서 코드 배후에 생성된다는 것입니다.예를 들어 다음과 같은 고급 대체 기능이 있습니다.

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

그런 다음 사용자가 구성한 대로 모든 혈관 정보를 포함하는 문자열을 통합하는 해당 루틴이 있습니다.

' 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

생성된 문자열은 다른 Excel 셀의 내용과 동일하게 사용할 수 있으며, 255자를 초과할 경우 클립보드 방식을 적절하게 사용하는 대체 함수로 전달됩니다.

이 템플릿은 다음과 같습니다.

또한 다음 스프레드시트 데이터:

다음 문서가 됩니다.

---

이것이 언젠가 누군가에게 도움이 되기를 진심으로 바랍니다.그것은 분명 큰 사업이었고 다시 발명해야 하는 복잡한 바퀴였다.어플리케이션은 5만 행이 넘는 VBA 코드로 구성되어 있기 때문에, 코드에 누군가가 필요한 중요한 방법을 참조하고 있는 경우는, 코멘트를 남겨 주세요.그것을 여기에 추가하겠습니다.

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Word bookmarks의 사용법을 설명합니다.

문서의 텍스트 섹션을 북마크하여 변수 이름을 지정할 수 있습니다.VBA를 사용하여 이 변수에 액세스할 수 있으며 문서의 내용을 대체 컨텐츠로 바꿀 수 있습니다.이것은 문서에 이름 및 주소와 같은 플레이스 홀더를 포함하기 위한 해결책입니다.

또한 북마크를 사용하여 북마크된 텍스트를 참조하도록 문서를 수정할 수 있습니다.문서 전체에 이름이 여러 번 나타나는 경우, 첫 번째 인스턴스를 책갈피로 지정할 수 있으며, 추가 인스턴스가 책갈피를 참조할 수 있습니다.첫 번째 인스턴스가 프로그램적으로 변경되면 문서 내의 다른 모든 변수 인스턴스도 자동으로 변경됩니다.

이제 플레이스홀더 텍스트를 북마크하고 문서 전체에서 일관된 이름 지정 규칙을 사용하여 모든 문서를 업데이트한 후 북마크가 있는 경우 각 문서를 반복해서 바꾸면 됩니다.

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

각 교환을 시도하기 전에 on error resume next 절을 사용하여 특정 문서에 나타나지 않는 변수 문제를 해결할 수 있을 것입니다.

Doug Glancy가 코멘트에서 북마크의 존재를 언급해 준 데 대해 감사드립니다.나는 사전에 그들의 존재를 전혀 몰랐다.저는 이 해결책으로 충분한지 여부에 대해 이 주제를 계속 보고하겠습니다.

XML 기반 접근 방식을 고려할 수 있습니다.

Word에는 사용자 정의 XML 데이터 바인딩 또는 데이터 바인딩 콘텐츠 컨트롤이라는 기능이 있습니다.내용 제어는 기본적으로 내용을 포함할 수 있는 문서 내 지점입니다."데이터 바인딩" 내용 제어는 docx zip 파일에 포함된 XML 문서에서 내용을 가져옵니다.XPath 표현식은 XML의 어떤 비트를 나타내는 데 사용됩니다.따라서 XML 파일만 포함하면 나머지는 Word가 수행합니다.

Excel은 XML로 데이터를 추출하는 방법을 가지고 있기 때문에 솔루션 전체가 잘 작동해야 합니다.

MSDN에는 콘텐츠 제어 데이터 바인딩에 대한 많은 정보가 있으므로(이 중 일부는 이전 SO 질문에서 참조됨) 여기에 포함시키지 않겠습니다.

하지만 바인딩을 설정하는 방법이 필요합니다.Content Control Toolkit을 사용하거나 Word 내에서 OpenDoPE 추가 기능을 사용할 수 있습니다.

비슷한 작업을 수행해 본 결과 테이블에 값을 삽입하는 것이 명명된 태그를 검색하는 것보다 훨씬 빠릅니다. 그러면 다음과 같이 데이터를 삽입할 수 있습니다.

    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

.셀(i+1,4)Range.Text = "Total:" End With 이 경우 테이블의 1행은 헤더입니다. 2행은 비어 있고 추가 행은 없습니다. 따라서 rows.add는 두 개 이상의 행이 첨부되면 적용됩니다.표는 매우 상세한 문서일 수 있으며 테두리와 셀 테두리를 숨김으로써 일반 텍스트처럼 보이게 할 수 있습니다.테이블은 문서 흐름에 따라 순차적으로 번호가 매겨집니다(예: Doc).표(1)는 첫 번째 표입니다...

언급URL : https://stackoverflow.com/questions/5106743/generate-word-documents-in-excel-vba-from-a-series-of-document-templates