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

I have dynamic named range of cell. I need to paste each named range in one page of word and move to next page for next named range. I tried copule of code, I am unable to do.Each named range data is overlapping each other. Can anyone help me, please.

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

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

2 个解决方案

#1

It sounds like you want to copy each range onto different pages so I'm not sure why you're using a union. Here is a quick example of copying each named range 'name' onto a new sheet in a word document. Note: I created a new doc for simplicity.

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

Edit - I added copy/paste functionality of data to the end. Formatting and such depends on what you have or want.

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

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

Resulting Word Document

产生的Word文档

#2

I don't think this is the best solution out there (as I don't normally play with Word VBA) but I have tried this and it does seems to work:

我不认为这是最好的解决方案(因为我通常不使用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

NOTE: I am creating a new word application. You might have to check if word is already open and how you want to deal with an existing word doc. Also, I'm not creating the word object. I have Microsoft Word xx.x Object Library referenced in the project as I prefer to work with built in libraries. Also, function presumes that you only have 1 worksheet and all your ranges are in that worksheet

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

#1