Макрос заполнения Word из Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос заполнения Word из Excel (Макросы/Sub)

Artem2292

Дата: Вторник, 17.11.2020, 19:12 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 0 ±

Замечаний: 0% ±

2010, 2019, 365

Всем привет!
Нужна Ваша помощь. На просторах интернета нашел макрос по замене закладок в Word данными Excel и подогнал под свои нужны. В целом все работает прекрасно, но столкнулся с одной проблемой, а именно - независимо от того, есть ли данные в ячейках Excel или нет, макрос все тянет в Word, т.е. если в ячейке пусто, то закладку в word заменяет на пустоту. Вопрос такой, можно ли как-то доработать макрос так, чтобы:
- если например, значения в excel есть только для закладок 1,2 и3 , то закладки 4, 5 и 6 не заполнялись бы вовсе
Или же
- если например, значения в excel есть только для закладок 1,2 и3, то весь текс, который идёт после закладки 3 в word был бы удален?

[vba]

Код

Sub ворд()
Dim objWord As Object, objDocument As Object
Dim NewPatchName As String
    Set objWord = CreateObject("word.application")

    objWord.Visible = True

    Set objDocument = objWord.Documents.Open(Filename:="C:\Users\....docx")


    NewPatchName = "ДКП" & " " & Sheets("График").Cells(2, 1)


    objDocument.bookmarks("Предложение1").Range.Text = Range("C2").Value
    objDocument.bookmarks("Предложение2").Range.Text = Range("C3").Value
    objDocument.bookmarks("Предложение3").Range.Text = Range("C4").Value
    objDocument.bookmarks("Предложение4").Range.Text = Range("C5").Value
    objDocument.bookmarks("Предложение5").Range.Text = Range("C6").Value
    objDocument.bookmarks("Предложение6").Range.Text = Range("C7").Value

    objDocument.bookmarks("Идея1").Range.Text = Range("C22").Value
    objDocument.bookmarks("Идея2").Range.Text = Range("C23").Value
    objDocument.bookmarks("Идея3").Range.Text = Range("C24").Value
    objDocument.bookmarks("Идея4").Range.Text = Range("C25").Value
    objDocument.bookmarks("Идея5").Range.Text = Range("C26").Value
    objDocument.bookmarks("Идея6").Range.Text = Range("C27").Value


    objDocument.bookmarks("Изменение1").Range.Text = Range("C42").Value
    objDocument.bookmarks("Изменение2").Range.Text = Range("C43").Value
    objDocument.bookmarks("Изменение3").Range.Text = Range("C44").Value
    objDocument.bookmarks("Изменение4").Range.Text = Range("C45").Value
    objDocument.bookmarks("Изменение5").Range.Text = Range("C46").Value
    objDocument.bookmarks("Изменение6").Range.Text = Range("C47").Value


        objDocument.bookmarks("Заявитель1").Range.Text = Range("E62").Value
        objDocument.bookmarks("Заявитель2").Range.Text = Range("E63").Value
        objDocument.bookmarks("Заявитель3").Range.Text = Range("E64").Value
        objDocument.bookmarks("Заявитель4").Range.Text = Range("E65").Value
        objDocument.bookmarks("Заявитель5").Range.Text = Range("E66").Value
        objDocument.bookmarks("Заявитель6").Range.Text = Range("E67").Value


    objDocument.bookmarks("Заключение1").Range.Text = Range("C82").Value
    objDocument.bookmarks("Заключение2").Range.Text = Range("C83").Value
    objDocument.bookmarks("Заключение3").Range.Text = Range("C84").Value
    objDocument.bookmarks("Заключение4").Range.Text = Range("C85").Value
    objDocument.bookmarks("Заключение5").Range.Text = Range("C86").Value
    objDocument.bookmarks("Заключение6").Range.Text = Range("C87").Value


    objDocument.SaveAs Filename:=ThisWorkbook.Path & "\" & NewPatchName & ".docx"
    objDocument.Close: objWord.Quit
    Set objDocument = Nothing: Set objWord = Nothing
    MsgBox "ГОТОВО!"
End Sub

[/vba]

сделал что-то типа такого и вставил в макрос перед сохранением файла:
[vba]

Код

Dim bm

For Each bm In objDocument.bookmarks
bm.Text = ""
bm.Range.Delete
Next

[/vba]
и ничего не выходит..

[vba]

Код

[/vba]

сделал что-то типа такого и вставил в макрос перед сохранением файла:
[vba]

Код

Dim bm

For Each bm In objDocument.bookmarks
bm.Text = ""
bm.Range.Delete
Next

[/vba]
и ничего не выходит..Artem2292

Сообщение отредактировал Artem2292 - Вторник, 17.11.2020, 23:40

Ответить

СообщениеВсем привет!
Нужна Ваша помощь. На просторах интернета нашел макрос по замене закладок в Word данными Excel и подогнал под свои нужны. В целом все работает прекрасно, но столкнулся с одной проблемой, а именно - независимо от того, есть ли данные в ячейках Excel или нет, макрос все тянет в Word, т.е. если в ячейке пусто, то закладку в word заменяет на пустоту. Вопрос такой, можно ли как-то доработать макрос так, чтобы:
- если например, значения в excel есть только для закладок 1,2 и3 , то закладки 4, 5 и 6 не заполнялись бы вовсе
Или же
- если например, значения в excel есть только для закладок 1,2 и3, то весь текс, который идёт после закладки 3 в word был бы удален?

[vba]

Код

[/vba]

сделал что-то типа такого и вставил в макрос перед сохранением файла:
[vba]

Код

Dim bm

For Each bm In objDocument.bookmarks
bm.Text = ""
bm.Range.Delete
Next

[/vba]
и ничего не выходит..

Автор - Artem2292
Дата добавления - 17.11.2020 в 19:12

RAN

Дата: Вторник, 17.11.2020, 23:39 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

If Len(Range("C5")) Then objDocument.Bookmarks("Предложение4").Range.Text = Range("C5").Value Else objDocument.Bookmarks("Предложение4").Range.Delete

[/vba]
и т.д., и т.п.

Быть или не быть, вот в чем загвоздка!

Ответить

Artem2292

Дата: Среда, 18.11.2020, 10:54 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 0 ±

Замечаний: 0% ±

2010, 2019, 365

Цитата RAN, 17.11.2020 в 23:39, в сообщении № 2 ()

и т.д., и т.п.

что-то не выходит. все описал, но при выполнении макроса выходит ошибка "run time error 5941 запрашиваемый номер семейства не существует"

Ответить

Artem2292

Дата: Среда, 18.11.2020, 14:25 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 0 ±

Замечаний: 0% ±

2010, 2019, 365

Вопрос снимается. Проблему решил через добавление доп.шаблонов. Может не совсем нормально, но все же

1. Добавил ячейку, в которой считаются заполненные ячейки по критерию "Предложение";
2. Исходя из значения этой ячейки прописал выбор шаблонов:
после
[vba]

Код

objWord.Visible = True

[/vba]
добавил ту самую ячейку и необходимый шаблон:
[vba]

Код

If Range("A5").Value = 1 Then
    Set objDocument = objWord.Documents.Open(Filename:="C:\Users\путь к файлу\1.docx")
    End If
    If Range("A5").Value = 2 Then
    Set objDocument = objWord.Documents.Open(Filename:="C:\Users\путь к файлу\2.docx")
    End If

[/vba]
и тд

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос заполнения Word из Excel (Макросы/Sub)

Страница 1 из 1
1