一連のドキュメントテンプレートからWordドキュメントを（Excel VBAで）生成する

Question

こんにちは。私はこれを簡潔で簡単なものにしようと思います。 :)

持っている

1. 入力が必要な一連のフィールド（名前、住所など）を含む40程度の定型Word文書。これは歴史的に手動で行われていましたが、繰り返しが多くて面倒です。
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＃」などのプレースホルダーテキストを使用し、各ドキュメントを開いて検索して置換する。これは、これ以上エレガントなものが提案されていない場合に私が頼るソリューションです。

Answer 1

私がこの質問をしたのは久しぶりで、私の解決策はますます洗練されてきました。ブックから直接取得する値、リストに基づいて特別に生成する必要があるセクション、ヘッダーとフッターで置換を行う必要性など、あらゆる種類の特別なケースに対処する必要がありました。

結局のところ、ユーザーが後でドキュメントを編集して、ドキュメントのプレースホルダー値を変更、追加、および削除することが可能だったため、ブックマークを使用するだけでは不十分でした。解決策は実際にはkeywordsを次のように使用することでした：

これは、ドキュメントに自動的に挿入される可能性のあるいくつかの値を使用するサンプルドキュメントの単なるページです。構造とレイアウトが完全に異なり、異なるパラメーターを使用する50を超えるドキュメントが存在します。 Word文書とExcelスプレッドシートで共有される唯一の共通の知識は、これらのプレースホルダー値が何を表すかについての知識です。 Excelでは、これは、キーワードを含むドキュメント生成キーワードのリストに格納され、その後にこの値を実際に含む範囲への参照が続きます。

これらは、必要な2つの重要な要素でした。いくつかの巧妙なコードを使用して、生成する各ドキュメントを反復処理し、既知のすべてのキーワードの範囲を反復処理し、各ドキュメントの各キーワードを検索して置換するだけで済みました。

---

最初に、ラッパーメソッドがあります。これは、生成するために選択されたすべてのドキュメントに対して反復するMicrosoft Wordのインスタンスを維持し、ドキュメントに番号を付け、ユーザーインターフェイス（エラーの処理、ユーザーへのフォルダーの表示など）を実行します。 ）

_' 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。前者では、ドキュメント生成キーワードのセットを反復処理し、ドキュメントにキーワードが含まれている場合はWordDocReplaceを呼び出します。 Findを実行して単語が存在しないことを確認し、無差別にreplaceを呼び出すと、キーワードの存在を確認してから置換する方がはるかに高速です。

_' 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文字を超える文字列を使用してWordでVBA置換を行っている場合、テキストを_Find.Replacement.Text_に配置しようとするとテキストが切り捨てられるが、_"^c"_を置換テキストとして使用すると、クリップボードから直接取得されます。これは私が使用しなければならない回避策でした。

2. 単にreplaceを呼び出すと、ヘッダーやフッターなどの一部のテキスト領域のキーワードが失われます。このため、実際には_document.StoryRanges_を反復処理し、それぞれに対して検索と置換を実行して、置換するWordのすべてのインスタンスを確実にキャッチする必要があります。

3. _Replacement.Text_を直接設定している場合、Excelの改行（vbNewLineおよびChr(10)）を単純なvbCrに変換して正しく表示する必要があります。 Wordで。そうしないと、置換テキストにExcelセルからの改行がある場合、Wordに奇妙な記号が挿入されます。ただし、クリップボードメソッドを使用する場合は、クリップボードに配置すると改行が自動的に変換されるため、これを行う必要はありません。

それがすべてを説明しています。コメントもかなり明確でなければなりません。これが魔法を実行する黄金のルーチンです：

_' 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関数を呼び出すことになりますが、ここで使用されているキーワードの特別な点は、元のワークブックの単一のセルにリンクしておらず、コードで生成されていることです。 -ワークブックのリストの後ろ。したがって、たとえば、事前交換の1つは次のようになります。

_'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文字を超える場合にクリップボードメソッドを適切に使用する置換関数に渡すことができます。

このテンプレート：

このスプレッドシートデータに加えて：

このドキュメントになります：

---

これがいつか誰かのお役に立てば幸いです。それは間違いなく巨大な仕事であり、再発明しなければならない複雑なホイールでした。アプリケーションは巨大で、50,000行を超えるVBAコードがあるため、誰かが必要な場所でコード内の重要なメソッドを参照した場合は、コメントを残してここに追加します。

Answer 2

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Wordの使用について説明していますブックマーク

ドキュメント内のテキストのセクションは、bookmarkedにすることができ、変数名を指定できます。 VBAを使用して、この変数にアクセスし、ドキュメントのコンテンツを代替コンテンツに置き換えることができます。これは、名前や住所などのプレースホルダーをドキュメントに含めるためのソリューションです。

さらに、ブックマークを使用して、ブックマークされたテキストを参照するようにドキュメントを変更できます。ドキュメント全体で名前が複数回出現する場合、最初のインスタンスにブックマークを付け、追加のインスタンスでブックマークを参照できます。最初のインスタンスがプログラムで変更されると、ドキュメント全体の変数の他のすべてのインスタンスも自動的に変更されます。

必要なのは、プレースホルダーテキストをブックマークし、ドキュメント全体で一貫した命名規則を使用してすべてのドキュメントを更新し、ブックマークが存在する場合はブックマークを置き換えて各ドキュメントを反復処理することだけです。

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

各置換を試行する前にon error resume next句を使用して、特定のドキュメントに表示されない変数の問題を解決できると思います。

コメントでブックマークの存在について言及してくれた Doug Glancy に感謝します。彼らの存在を事前に知りませんでした。このソリューションで十分かどうかについては、このトピックを投稿し続けます。

Answer 3

XMLベースのアプローチを検討するかもしれません。

Wordには、カスタムXMLデータバインディングまたはデータバインドコンテンツコントロールと呼ばれる機能があります。コンテンツコントロールは、本質的にはコンテンツを含むことができるドキュメント内のポイントです。 「データバインド」コンテンツコントロールは、docx Zipファイルに含めるXMLドキュメントからコンテンツを取得します。 XPath式は、XMLのどのビットを表すために使用されます。したがって、XMLファイルを含めるだけで、あとはWordが行います。

ExcelにはデータをXMLとして取得する方法があるため、ソリューション全体が適切に機能するはずです。

MSDNのコンテンツコントロールのデータバインディングに関する情報はたくさんあります（そのうちのいくつかは以前のSOの質問）で参照されているため）。

ただし、バインディングを設定する方法が必要です。 Content Control Toolkitを使用するか、Word内から実行する場合は、私のOpenDoPEアドインを使用できます。

Answer 4

同様のタスクを実行した結果、値をテーブルに挿入する方が名前付きタグを検索するよりもはるかに高速であることがわかりました。データは次のように挿入できます。

    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：" End Withこの場合、テーブルの行1がヘッダーでした。行2は空で、それ以上行はありませんでした。したがって、rows.addは複数の行がアタッチされたときに1回だけ適用されます。表は非常に詳細なドキュメントにすることができ、境界線とセルの境界線を非表示にすることで、通常のテキストのように見せることができます。表は、ドキュメントフローに従って順番に番号が付けられています。 （つまり、Doc.Tables（1）は最初のテーブルです...