关于Word宏的几个问题

Question

我需要从 Excel 中获取姓名列表并将其插入到 Word 文档中，为每个姓名打印一个文档。该文档有一些文本和一个名为“名称”的书签。代码如下。

首先，我想知道是否可以检测 Excel 电子表格中的姓名列表有多长并获取该列表，而不是对数字进行硬编码。

其次，我不知道如何删除已经放入文档中的文本。当我在书签中插入文本时，它会附加在书签后面，因此如果我继续添加名称，它们都会堆叠在一起。

也许有了代码，这会更清楚：

Sub insertar_nombre()
    Dim Excel As Excel.Application
    Dim Planilla As Excel.Workbook
    Dim Hoja As Excel.Worksheet

    Set Excel = CreateObject("Excel.Application")
    Dim Filename As String
    Dim fname As Variant
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Title = "Seleccionar Documento de Excel"
        .Show
        For Each fname In .SelectedItems
            Filename = fname
        Next
    End With
    Set Planilla = Excel.Workbooks.Open(Filename)
    Set Hoja = Planilla.Worksheets(1)
    Dim Nombre As String
    For Count = 2 To 10
        Nombre = Hoja.Cells(Count, 1).Value
        ActiveDocument.Bookmarks("name").Range.Text = Nombre
        ActiveDocument.PrintOut
    Next
End Sub

请原谅我，如果这段代码明显错误或其他什么，我只是从这个开始。

Answer 1

我需要从 Excel 中获取姓名列表并将其插入到 Word 文档中，为每个姓名打印一个文档。

为什么不直接使用邮件合并功能呢？

Answer 2

以下 Sub 应该可以为您解决此问题，但您可能需要更改书签的定义方式。

插入书签的方法不止一种。此方法要求通过突出显示文本来插入书签，而不是简单地将光标定位在文本中的某个位置。

Sub insertar_nombre()

Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet

Dim strFilename As String

Dim bkmName As Word.Range
Dim strBookmarkOriginalText As String

Dim lngRowLast As Long
Dim rngRowStart As Excel.Range
Dim rngRowEnd As Excel.Range

Dim rngNames As Excel.Range
Dim rngName As Excel.Range


'Open file dialog and only allow Excel files'
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .Title = "Seleccionar Documento de Excel"

    'Only let them select Excel files'
    .Filters.Clear
    .Filters.Add "Excel Documents (*.xls)", "*.xls"

    'Check if a file is selected'
    If .Show = True Then

        'Since AllowMultiSelect is set to False, _
            only one file can be selected'
        strFilename = .SelectedItems(1)
    Else

        'No file selected, so exit the Sub'
        Exit Sub
    End If
End With


'Set the bookmark to a Word range (not a Bookmark object)'
Set bkmName = ActiveDocument.Bookmarks("name").Range

'Save the original text of the bookmark'
strBookmarkOriginalText = bkmName.Text


'Open the Excel file'
Set xlWorkbook = Excel.Workbooks.Open(strFilename)
Set xlWorksheet = xlWorkbook.Worksheets(1)

'Range of the first cell that contains a name'
Set rngRowStart = xlWorksheet.Cells(2, 1)

'Range of the last cell in the column'
lngRowLast = xlWorksheet.Range("A65536").End(xlUp).Row
Set rngRowEnd = xlWorksheet.Cells(lngRowLast, 1)

'Range of all cells from first name cell to last name cell'
Set rngNames = xlWorksheet.Range(rngRowStart, rngRowEnd)


'Loop through the range of names'
For Each rngName In rngNames

    'Ignore any blank cells'
    If rngName <> vbNullString Then

        'Set the text of the bookmark range to the name from Excel'
        bkmName.Text = rngName

        'The above statement deleted the Bookmark, so create _
            a new Bookmark using the range specified in bkmName'
        ActiveDocument.Bookmarks.Add Name:="name", Range:=bkmName

        'Print the document'
        ActiveDocument.PrintOut
    End If
Next


'Restore the orignal value of the bookmark'
bkmName.Text = strBookmarkOriginalText
ActiveDocument.Bookmarks.Add Name:="name", Range:=bkmName

'Close the Workbook without saving'
xlWorkbook.Close SaveChanges:=False

End Sub

希望这有帮助。