Добрый день. Подскажите, как в файл "Акт_ШАБЛОН_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
[вложение удалено администратором]