Excel Word Макросы: Вставить таблицу из Excel в Файл Word

[Pti4ka]

Добрый день. Подскажите, как в файл "Акт_ШАБЛОН_2.doc" после строки "Адреса, реквизиты и подписи Сторон:" вставить таблицу из файла "Таблицы вставки.xlsb" с помощью макроса?

[вложение удалено администратором]

[вложение удалено администратором]

[Администратор]

В пункте 2 укажите полное имя (путь и имя) ворд-файла.
Макрос запускайте из эксель. Макрос сделан для эксель-файла, который вы выложили на форуме.
В ворд-файл я вставил обычную надпись. После вставки я сделал у надписи обтекание "В тексте". Макрос просматривает все рисунки в ворд-файле (надпись относится к рисункам) и если внутри надписи есть текст "таблица", то вставляет в это место скопированные данные.
Я сделал заливку у надписи, чтобы бросалось в глаза.

Макрос

Sub Макрос()

    Dim appWord As Object, doc As Object, shp As Object, rng As Object
    Dim strFileName As String, i As Long
   
   
    '1. Копирование эксель-таблицы.
    Range("A1:B14").Copy
   
    '2. Здесь укажите, где находится ворд-файла.
    strFileName = "C:\Users\User\Desktop\Акт ШАБЛОН_2.doc"
   
    '3. Запуск программы "Word".
    Set appWord = CreateObject(Class:="Word.Application")
   
    '4. Открытие и vba-именование ворд-файла.
    Set doc = appWord.Documents.Open(Filename:=strFileName)
   
    '5.
    ' Цикл по рисункам в ворд-файле.
    For i = doc.Shapes.Count To 1 Step -1
   
        '1) Vba-именование рисунка.
        Set shp = doc.Shapes(i)
       
        '2) Если это не надпись, то переход к следующему рисунку.
        ' 17 - это "msoTextBox".
        If shp.Type <> 17 Then
            GoTo metka_NextShape
        End If
       
        '3) Если в надписи нет нужного текста, то переход к следующему рисунку.
        If shp.TextFrame.TextRange.Text <> "таблица" & Chr(13) Then
            GoTo metka_NextShape
        End If
       
        '4) Запоминанием, где находилась надпись.
        Set rng = shp.Anchor
       
        '5) Удаление надписи. Если не удалять, то происходит непонятное.
        shp.Delete
       
        '6) Вставка скопированной эксель-таблицы.
        rng.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=True
       
        '7) Остальные рисунки не надо просматривать.
        Exit For
       
metka_NextShape:
    Next i

    '6. Закрытие ворд-файла с сохранением.
    doc.Close SaveChanges:=True
   
    '7. Закрытите программы "Word".
    appWord.Quit
   
    '8. Выход из режима копирования.
    Application.CutCopyMode = False

End Sub

[свернуть]

[вложение удалено администратором]

[Pti4ka]

Все отлично работает! Спасибо большое.