Word 文档无法正确关闭

Question

正确地从下拉列表中动态填充数据；但是，如何让 Word 文档在每个条目之间正确关闭？

问题：

Word 文档没有在 Excel 动态下拉列表中的每个新条目之间正确关闭。

发生了什么：

循环在每个医院执行；但是，Word 不会在每个新实体之间关闭。结果是所有的地址和表格都在不间断地插入。

应该发生什么：

每个医院在新的 Word 文档中都有自己的唯一数据（附件，Excel 表“表”在调用 B2 中有一个下拉列表，可自动填充表 1 和医院地址；Word 文档有书签可以插入数据）。

在此先感谢您的专业知识。我尝试了各种命令来关闭 Word 中的活动文档（未显示），但随后无法使用模板再次打开 Word。意识到可能有一个简单的解决方案可以合并到现有代码中。

问候， 凯伦

 Sub MMISPMT()
    
    Worksheets("table").Activate
    
    'Declare variables
    
    Dim WordApp As Object 
    Dim WordDoc As Object 
    Dim dvCell As Range   
    Dim inputRange As Range
    Dim c As Range
    
    ActiveWindow.View = xlNormalView 
    
    'Set variables
    'Which cell has data validation
    Set dvCell = Worksheets("Table").Range("B2")  'this is a drop-down box of entity name values that 
    populates address info and table 1 in Word document
    'Determine where validation comes from
    Set inputRange = Evaluate(dvCell.Validation.Formula1)
    Set WordApp = New Word.Application ' based on the template ref'd in WordDoc
            
    'Word template to be used
    Set WordDoc = WordApp.Documents.Add(Template:="C:\<pathway>\letter.docx", NewTemplate:=False, 
    DocumentType:=0)
    
    'Begin loop
    Application.ScreenUpdating = False
    
    For Each c In inputRange
     dvCell = c.Value
     MsgBox dvCell
     Debug.Print dvCell 
    
    Dim table1 As Range
    Dim HosName As Range
    Dim address1 As Range
    Dim city As Range
    Dim zip As Range
    
    'Declare variables
    
    Set table1 = Range("a10:g15")
    Set HosName = Range("b2")
    Set address1 = Range("ad5")
    Set city = Range("ad6")
    Set zip = Range("ad7")
    
    HosName.Select
    Selection.Copy
    WordApp.Visible = True
    WordApp.ActiveDocument.Bookmarks("HosName").Select
    Set objSelection = WordApp.Selection
    objSelection.PasteSpecial DataType:=wdPasteText
    
    address1.Select
    Selection.Copy
    WordApp.Visible = True
    WordApp.ActiveDocument.Bookmarks("address1").Select
    Set objSelection = WordApp.Selection
    objSelection.PasteSpecial DataType:=wdPasteText
    
    
    city.Select
    Selection.Copy
    WordApp.Visible = True
    WordApp.ActiveDocument.Bookmarks("city").Select
    Set objSelection = WordApp.Selection
    objSelection.PasteSpecial DataType:=wdPasteText
    
    
    zip.Select
    Selection.Copy
    WordApp.Visible = True
    WordApp.ActiveDocument.Bookmarks("zip").Select
    Set objSelection = WordApp.Selection
    objSelection.PasteSpecial DataType:=wdPasteText
    
    
    table1.Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    WordApp.Visible = True
    WordApp.ActiveDocument.Bookmarks("table1").Select
    Set objSelection = WordApp.Selection
    objSelection.Paste
    
    'Generate the Word template per hospital with data
    WordApp.ActiveDocument.SaveAs2 Filename:="C:\<pathway>\" & HosName & " " & Format((Year(Now() + 1) 
    Mod 100), "20##") & _
            Format((Month(Now() + 1) Mod 100), "0#") & _
            Format((Day(Now()) Mod 100), "0#") & "-report.docx", _
                                   FileFormat:=wdFormatXMLDocument 
            
    Next c
    
     Application.ScreenUpdating = True
     
    End Sub

Answer 1

您需要在循环顶部打开模板，然后在循环底部保存并关闭文档。

您还可以通过将复制/粘贴分解为单独的方法来整理代码。

Sub MMISPMT()
    
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim dvCell As Range
    Dim inputRange As Range
    Dim c As Range, wsTable As Worksheet
    
    Set wsTable = Worksheets("Table")
    Set dvCell = Worksheets("Table").Range("B2")
    Set inputRange = Evaluate(dvCell.Validation.Formula1)
    
    Set WordApp = New Word.Application ' based on the template ref'd in WordDoc
            
    For Each c In inputRange.Cells
    
    
        Set WordDoc = WordApp.Documents.Add(Template:="C:\<pathway>\letter.docx", _
                                            NewTemplate:=False, DocumentType:=0)
        dvCell = c.Value
        
        CopyToBookmark wsTable.Range("B2"), WordDoc, "HosName"
        CopyToBookmark wsTable.Range("AD5"), WordDoc, "address1"
        CopyToBookmark wsTable.Range("AD6"), WordDoc, "city"
        CopyToBookmark wsTable.Range("AD7"), WordDoc, "zip"
        CopyToBookmark wsTable.Range("A10:G15"), WordDoc, "table1", False
        
        WordDoc.SaveAs2 Filename:="C:\<pathway>\" & HosName & " " & _
                               Format((Year(Now() + 1) Mod 100), "20##") & _
                               Format((Month(Now() + 1) Mod 100), "0#") & _
                               Format((Day(Now()) Mod 100), "0#") & "-report.docx", _
                                   FileFormat:=wdFormatXMLDocument
        WordDoc.Close
    
    Next c
    
End Sub

'transfer/copy data from a Range into a named bookmark in doc
'   either directly as text or copy/paste as table
Sub CopyToBookmark(rng As Range, doc As Word.document, bmk As String, _
                   Optional AsValue As Boolean = True)
    If AsValue Then
        doc.bookmarks(bmk).Range.Text = rng.Value
    Else
        rng.Copy
        doc.bookmarks(bmk).Range.Paste
    End If
End Sub