Excel VBA копирует каждый именованный диапазон до слова

Question

У меня динамический именованный диапазон ячеек. Мне нужно вставить каждый именованный диапазон на одной странице слова и перейти на следующую страницу для следующего именованного диапазона. Я пробовал copule кода, я не могу этого сделать. Каждый указанный диапазон данных перекрывает друг друга. Кто-нибудь может мне помочь.

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

Похоже, вы хотите скопировать каждый диапазон на разные страницы, поэтому я не уверен, почему вы используете союз. Ниже приведен краткий пример копирования каждого имени именованного диапазона «имя» на новый лист в текстовом документе. Примечание. Я создал новый документ для простоты.

Редактировать - Я добавил функции копирования/вставки данных в конец. Форматирование и многое другое зависит от того, что у вас есть или чего хотите.

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

Я не думаю, что это самое лучшее решение там (как я не» t нормально играть с 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 

ПРИМЕЧАНИЕ: Я создаю новое приложение слово. Возможно, вам придется проверить, открыто ли слово и как вы хотите иметь дело с существующим документом word. Кроме того, я не создаю объект слова. У меня есть Microsoft Word xx.x Object Library, на который ссылается проект, поскольку я предпочитаю работать со встроенными библиотеками. Кроме того, функция предполагает, что у вас только 1 рабочий лист, и все ваши диапазоны находятся на этом листе