从excel填充word文档而不删除书签

时间:2017-04-04 14:31:58

标签: excel vba excel-vba

我正在尝试根据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

1 个答案:

答案 0 :(得分:1)

BookmarksDocument对象的属性,不属于Word Application对象

所以你必须改变:

wd.Bookmarks.Add BookMarkName,BMRange

为:

wd.ActiveDocument.Bookmarks.Add BookMarkName,BMRange

此外,您可以考虑以下内容:

  • 您应该将Public变量的使用限制在严格不可避免的地方(例如:与UserForms进行通信)

  • 避免使用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