從Excel中填充Word文檔而不刪除書籤

Question

我想根據Excel中的數據填充Word文檔。由於特定工作要求的數量衆多，我需要在Word中保留書籤。我已經將這些網站用作資源。

Replace Text in Bookmark in Word without Deleting Bookmark http://wordmvp.com/FAQs/MacrosVBA/InsertingTextAtBookmark.htm http://www.wiseowl.co.uk/blog/s199/word-bookmarks.htm

我在CopyCell的最後一行得到一個編譯錯誤。

Option Explicit 
Dim wd As New Word.Application 
Dim DataCell As Range 

Sub ReportData() 

'Open word template 
wd.Documents.Open (Range("D4") & Range("D5")) 
wd.Visible = True 

'Creates range with all of the data used in the report 
Dim DataRange As Range 
Range("D7").Select 
Set DataRange = Range(ActiveCell, ActiveCell.End(xlDown)) 

'Uses copycell function. "Name" is the bookmark name, 0 is the Rowoffset 
For Each DataCell In DataRange 
    CopyCell "Name", 0 
    CopyCell "Employer", 1 
Next 

End Sub 

Sub CopyCell(BookMarkName As String, RowOffset As Integer) 

Dim BMRange As Word.Range 

wd.Selection.GoTo What:=wdGoToBookmark, Name:=BookMarkName 
Set BMRange = wd.Selection.Range.Duplicate 
BMRange.Text = DataCell.Offset(RowOffset, 0).Value 
wd.Bookmarks.Add BookMarkName, BMRange 

End Sub 

Answer 1

Bookmarks是不是一個Document對象的屬性字Application對象

，所以你必須改變：

wd.Bookmarks.Add BookMarkName，BMRange

到：

wd.ActiveDocument.Bookmarks.Add BookMarkName，BMRange

此外，您可以考慮一下如下：

• 你應該限制使用公共變量來這裏確實不可避免的（如：與用戶窗體通信）

• 避免Activate/ActiveXXX/Selection/Select模式並使用完全限定範圍參考

• 您正在遍歷「垂直」範圍，然後您將當前單元格「垂直」偏移， （即一個單元向下）：可能是你想要「水平」偏移（即到相鄰單元）？

上述所有我會建議你的代碼的重構如下內容：

Option Explicit 

Sub ReportData() 

    Dim wd As Word.Application 
    Dim DataCell As Range 

    Set wd = New Word.Application 

    'Open word template 
    wd.Documents.Open Range("D4") & Range("D5") 
    wd.Visible = True 

    'Creates range with all of the data used in the report 
    With Range("D7") 
     'Uses copycell function. "Name" is the bookmark name, 0 is the Rowoffset 
     For Each DataCell In Range(.Cells, .End(xlDown)) 
      CopyCell wd, DataCell, "Name", 0 
      CopyCell wd, DataCell, "Employer", 1 
     Next 
    End With 

    wd.ActiveDocument.Close True '<--| close and save word document 
    wd.Quit '<--| close word application 
    Set wd = Nothing '<--| clean memory 
End Sub 

Sub CopyCell(wd As Word.Application, DataCell As Range, BookMarkName As String, ColOffset As Integer) 

    Dim BMRange As Word.Range 

    wd.Selection.GoTo What:=wdGoToBookmark, Name:=BookMarkName 
    Set BMRange = wd.Selection.Range.Duplicate 
    BMRange.Text = DataCell.Offset(0, ColOffset).Value 
    wd.ActiveDocument.Bookmarks.Add BookMarkName, BMRange 

End Sub