Блог

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

 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
  

Похоже, вы хотите скопировать каждый диапазон на разные страницы, поэтому я не уверен, почему вы используете объединение. Вот краткий пример копирования «имени» каждого именованного диапазона на новый лист в документе 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 amp; 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

Я не думаю, что это лучшее решение (поскольку я обычно не играю с 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. Возможно, вам придется проверить, открыт ли word уже и как вы хотите работать с существующим документом word. Кроме того, я не создаю объект word. Я Microsoft Word xx.x Object Library ссылался на проект, поскольку предпочитаю работать со встроенными библиотеками. Кроме того, функция предполагает, что у вас есть только 1 рабочий лист, и все ваши диапазоны находятся на этом листе