VBA: копирование областей печати в Word

[timsun]

Доброго времени суток.
Имеется книга состоящая из множества листов с данными.
На каждом листе задана область печати, диапазон ячеек в каждой области печати может быть различным.
При копировании диапазонов областей печати из Excel в Word средствами VBA возникает проблема: диапазоны областей печати, состоящие из не смежных диапазонов ячеек (например: ActiveSheet.PageSetup.PrintArea = "$B$3:$K$29,$N$3:$T$21"), не копируются в Word.

Вопрос: имеется ли возможность в VBA для решения данной проблемы.

[EducatedFool]

Да, конечно.
Разбиваете эти диапазоны на части - и копируете в Word по-одному:

Sub test()
    Dim ra As Range, ar As Range
    Set ra = Range(ActiveSheet.PageSetup.PrintArea) ' область печати
    For Each ar In ra.Areas    ' перебираем все области
        'Debug.Print ar.Address
        ar.Copy    ' копируем
        appWord.PasteExcelTable False, False, False    ' вставляем в Word
    Next ar
    Application.CutCopyMode = False
End Sub

[timsun]

Спасибо за помощь.
Но код не работает на странице с областью печати, состоящей из не смежных диапазонов ячеек возникает ошибка:

Run-time error '1004'
Method 'Range' of object '_Global' failed

[EducatedFool]

Неужели так сложно почитать правила раздела, и прикрепить файл, на которой возникает ошибка?

Я тестировал на вашем примере (ActiveSheet.PageSetup.PrintArea = "$B$3:$K$29,$N$3:$T$21") - всё работает

[timsun]

Пользуюсь MS Office 2010.
Файл, где возникает ошибка, приложил согласно правилам. Хотя ошибка у меня возникает в любом похожем примере, где количество диапазонов >1.

[EducatedFool]

У меня всё работает:

Sub test()
    Dim ra As Range, ar As Range
    Set wa = CreateObject("Word.Application")
    wa.Visible = True: Set wd = wa.Documents.Add

    Set ra = Range(ActiveSheet.PageSetup.PrintArea)    ' область печати
    For Each ar In ra.Areas    ' перебираем все области
        ar.Copy    ' копируем
        wa.Selection.PasteExcelTable False, False, False    ' вставляем в Word
    Next ar
    Application.CutCopyMode = False
End Sub

Скриншот результата: http://www.ExcelVBA.ru/pictures/20110915-88m-214kb.jpg

Пример в вашем файле: http://excelvba.ru/XL_Files/Sample__...__16-14-09.zip

[timsun]

Попробовал на разных компах: переменной ra присваивается значение только при версии Excel 2003, видимо что-то с настройками, буду искать.
В любом случае, спасибо.

[EducatedFool]

Проблема была в том, что Excel 2003 выдаёт свойство ActiveSheet.PageSetup.PrintArea так:

$B$1:$K$19,$N$1:$V$14

а Excel 2007 и старше - так:

$B$1:$K$19;$N$1:$V$14

Чтобы функция RANGE поняла адрес диапазона, он должен разделяться запятыми.
Поэтому надо исправить код макроса:

Sub test()
    Dim ra As Range, ar As Range
    Set wa = CreateObject("Word.Application")
    wa.Visible = True: Set wd = wa.Documents.Add

    Set ra = Range(Replace(ActiveSheet.PageSetup.PrintArea, ";", ","))  ' область печати
    For Each ar In ra.Areas    ' перебираем все области
        ar.Copy    ' копируем
        wa.Selection.PasteExcelTable False, False, False    ' вставляем в Word
    Next ar
    Application.CutCopyMode = False
End Sub

Теперь будет работать во всех версиях Excel: http://excelvba.ru/XL_Files/Sample__...__17-39-00.zip