Question

我有动态命名范围的单元格。我需要将每个命名范围粘贴到一个单词的页面中，然后移动到下一个页面以获取下一个命名范围。我尝试了一些代码，我无法做到。每个命名的范围数据都是相互重叠的。请有人帮帮我。

Set wbBook = ActiveWorkbook
Set rs = wbBook.Names(1).RefersToRange

For i = 2 To wbBook.Names.Count
    Set rs = Union(rs, wbBook.Names(i).RefersToRange)
Next

rs.Copy

With wd.Range
    .Collapse Direction:=0
    .InsertParagraphAfter
    .Collapse Direction:=0
    .PasteSpecial False, False, True
    Application.CutCopyMode = False
End With

Answer 1

听起来你想将每个范围复制到不同的页面上，所以我不确定你为什么要使用联合。下面是将每个命名范围“name”复制到word文档中的新工作表的快速示例。注意：为简单起见，我创建了一个新文档。

编辑 - 我添加了数据的复制/粘贴功能。格式化等取决于您拥有或想要的内容。

Sub main()
    'Create new word document
    Dim objWord As Object
    Dim objDoc As Object
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.documents.Add()

    Dim intCounter As Integer
    Dim rtarget As Word.Range
    Dim wbBook As Workbook
    Set wbBook = ActiveWorkbook

    'Loop Through names
    For intCounter = 1 To wbBook.Names.Count
       Debug.Print wbBook.Names(intCounter)

       With objDoc
            Set rtarget = .Range(.Content.End - 1, .Content.End - 1)

            'Insert page break if not first page
            If intCounter > 1 Then rtarget.insertbreak Type:=wdPageBreak

            'Write name to new page of word document
            rtarget.Text = wbBook.Names(intCounter).Name & vbCr

            'Copy data from named range
            Range(wbBook.Names(intCounter)).Copy
            Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
            rtarget.Paste
       End With
    Next intCounter
End Sub

<强> Excel中

生成的Word文档

Answer 2

我不认为这是最好的解决方案（因为我通常不会使用Word VBA），但我尝试了这个并且似乎确实有效：

Sub AddNamedRangesToWordDoc()

    Dim oWord As Word.Application
    Dim oDoc As Word.Document
    Dim intCount As Integer
    Dim oRng As Range
    Dim oSelection As Object

    Set oWord = New Word.Application
    Set oDoc = oWord.Documents.Add
    oWord.Visible = True

    For intCount = 1 To ActiveWorkbook.Names.Count

        Set oRng = Range(ActiveWorkbook.Names(intCount).RefersToRange.Name.Name)
        oRng.Copy

        oDoc.ActiveWindow.Selection.PasteSpecial , , 0
        Set oSelection = oWord.Selection
        oSelection.InsertBreak (wdPageBreak)

    Next

    Set oSelection = Nothing
    Set oRng = Nothing
    Set oDoc = Nothing
    Set oWord = Nothing

End Sub

注意：我正在创建一个新的单词应用程序。您可能必须检查单词是否已打开以及您希望如何处理现有单词doc。另外，我没有创建单词对象。我在项目中引用Microsoft Word xx.x Object Library，因为我更喜欢使用内置库。此外，函数假设您只有1个工作表，并且所有范围都在该工作表中

Excel VBA复制将每个命名范围粘贴到单词

2 个答案: