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

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

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

person Manish    schedule 12.10.2016    source источник


Ответы (2)


Похоже, вы хотите скопировать каждый диапазон на разные страницы, поэтому я не уверен, почему вы используете объединение. Вот быстрый пример копирования каждого именованного диапазона «name» на новый лист в текстовом документе. Примечание. Для простоты я создал новый документ.

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

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

введите описание изображения здесь

person Automate This    schedule 12.10.2016
comment
Спасибо за ваш ответ! Данные не отображаются, вместо этого отображается диапазон рабочего листа на каждой странице (= GenForm! $ A $ 1: $ E $ 22, = GenForm! $ A $ 24: $ E $ 29 и т. Д.). Есть ли другая причина для этого? - person Manish; 13.10.2016
comment
См. Правка - я добавил простую копию / вставку данных. Из вашего кода не было ясно, что вам нужно что-то другое, кроме диапазона, поэтому я изначально оставил это. - person Automate This; 13.10.2016

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

person Zac    schedule 13.10.2016