Word VBA Макросы: Копирование тел таблиц из нескольких файлов Word в один файл.

Автор Respect, 11 мая 2020, 16:12

Respect

Задача такая: есть несколько более-менее однотипных файлов 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
[свернуть]