Задача такая: есть несколько более-менее однотипных файлов Word, в каждом из которых есть таблица. Задача стоит скопировать (без шапки) последовательно из каждого файла таблицу и объединить в одну в файле Word.
В файле одна таблица.
Код ниже делает практически все, что нужно, только копирует содержимое каждого файла полностью. Как его модифицировать так, чтобы он копировал только таблицы из файлов (без шапки)?
Макрос
Sub MergeFiles()
Dim avFiles, lr As Long
Dim docAct As Document, docNow As Document
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "*.doc*"
.AllowMultiSelect = True
If .Show = False Then Exit Sub
Set docAct = ActiveDocument
For lr = 1 To .SelectedItems.Count
Set docNow = Documents.Open(.SelectedItems(lr))
docNow.Range.Copy
docAct.Range(docAct.Range.End - 1).Paste
docAct.Range(docAct.Range.End - 1).InsertBreak Type:=0
docNow.Close 0
Next lr
End With
End Sub
Макрос не объединяет таблицы в одну, а только копирует их в один файл.
Макрос
Sub MergeFiles()
Dim docAct As Document, docSrc As Document, tbl As Table
Dim FNs()
Dim i As Long
' Юзер выбирает один или несколько ворд-файлов.
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Документы Word", "*.doc*"
If .Show = False Then Exit Sub
ReDim FNs(.SelectedItems.Count)
For i = 1 To .SelectedItems.Count
FNs(i) = .SelectedItems(i)
Next i
End With
' Создание ссылки на активный файл.
Set docAct = ActiveDocument
' Копирование тел таблиц из выбранных файлов в активный файл.
For i = 1 To UBound(FNs)
' Открытие выбранного файла.
Set docSrc = Documents.Open(FNs(i))
' Создание ссылки на первую таблицу в выбранном файле.
Set tbl = docSrc.Tables(1)
' Выделение строк со второй по последнюю.
tbl.Rows(2).Select
Selection.MoveDown Unit:=wdLine, Count:=tbl.Rows.Count - 2, Extend:=wdExtend
' Копирование выделенного фрагмента.
Selection.Copy
' Вставка скопированного в активный файл.
docAct.Range(docAct.Range.End - 1).Paste
' Вставка разрыва страницы.
docAct.Range(docAct.Range.End - 1).InsertBreak Type:=0
' Закрытие файла-источника.
docSrc.Close SaveChanges:=False
Next i
End Sub