Форум программистов, компьютерный форум, киберфорум
Наши страницы
setood
Войти
Регистрация
Восстановить пароль
Рейтинг: 5.00. Голосов: 1.

Удобное заполнение Word из Excel

Запись от setood размещена 29.06.2019 в 00:10

Всем привет!
В этой заметке я расскажу, как легко и просто можно сделать подстановку в Word документ значений из ячеек Excel.
Алгоритм работы следующий, для каждой выделенной ячейки в Excel берется текст заголовка столбца, в word шаблоне ищется текст этого заголовка (обернутый символами “{%” и “%}”) и заменяется значением ячейки.
Например:
В Excel выделены ячейки B4 и С4
Нажмите на изображение для увеличения
Название: 1.jpg
Просмотров: 48
Размер:	15.9 Кб
ID:	5409
Изначально Word документ выглядит так:
Нажмите на изображение для увеличения
Название: 2.jpg
Просмотров: 50
Размер:	10.0 Кб
ID:	5410
У ячейки B4 заголовком столбца является текст «имя». Поэтому в Word везде текст «{%имя%}» будет заменен содержимым выделенной ячейки «Николай».
Аналогично для ячейки С4 заголовок «паспорт», поэтому в Word весь текст «{%паспорт%}» будет заменен на «12 12».
Для запуска макроса необходимо:
1. Установить макрос:
Кликните здесь для просмотра всего текста

1. Открыть файл Excel в который необходимо добавить макрос
2. Нажать комбинацию клавиш alt+f11
3. В открывшемся окне вверху слева сделайте двойной клик по «Эта книга»
Нажмите на изображение для увеличения
Название: 1.png
Просмотров: 47
Размер:	20.9 Кб
ID:	5412
4. Справа откроется окно для ввода текста
5. Вставьте в него следующий текст:
Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub CreateWordFile()
 Dim filePath As String
 Dim data As Collection
 Dim headersRow As Integer
 headersRow = 1
 filePath = SelectWordTemplate()
 If filePath <> "" Then
  Set data = GetSelectedData(headersRow)
  Call CreateAndFillWordDocument(filePath, data)
 End If
End Sub
 
Function SelectWordTemplate() As String
Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Title = "Select a Word Template"
        .Filters.Add "Word Files", "*.dotx;*.docx;*.docb;*.doc", 1
        .AllowMultiSelect = False
        If .Show = True Then
            SelectWordTemplate = fd.SelectedItems(1)
        End If
    End With
End Function
 
Function GetSelectedData(headerRowIndex As Integer) As Collection
 Set GetSelectedData = New Collection
 Dim cell As Range
 Dim cellValue As String
 Dim cellKey As String
 Dim emptyCellCounter As Integer
 emptyCellCounter = 0
 For Each cell In Selection
      cellValue = cell.Value2
      cellKey = cell.Worksheet.Cells(headerRowIndex, cell.Column).Value2
      GetSelectedData.Add Array(cellKey, cellValue)
      If cellValue = "" Then
        emptyCellCounter = emptyCellCounter + 1
      Else
        emptyCellCounter = 0
      End If
      If emptyCellCounter > 100 Then
        Exit Function
      End If
 Next cell
End Function
 
Sub CreateAndFillWordDocument(file As String, data As Collection)
Set wApp = CreateObject("Word.Application")
wApp.DisplayAlerts = False
Dim wDoc As Object
Set wDoc = wApp.Documents.Add(Template:=file, NewTemplate:=False, DocumentType:=0)
Call FillWordDocument(wDoc, data)
wApp.DisplayAlerts = True
wApp.Visible = True
End Sub
 
Sub FillWordDocument(wDoc As Object, data As Collection)
Dim key As Variant
 For i = 1 To data.count
   Dim text As String
   Dim replace As String
   Dim content As String
   text = "{%" & data.Item(i)(0) & "%}"
   replace = data.Item(i)(1)
   Set myRange = wDoc.content
   myRange.Find.Execute FindText:=text, ReplaceWith:=replace
Next i
End Sub

6. Нажмите «посмотреть в Excel»
Название: 2.png
Просмотров: 241

Размер: 42.7 Кб
7. Откроется Excel с вашим файлом. Нажмите сохранить как.
8.Выберите тип фала «Книга Excel с поддержкой макросов (*.xlsm) и нажмите сохранить.
Нажмите на изображение для увеличения
Название: 3.png
Просмотров: 54
Размер:	43.8 Кб
ID:	5414
Макрос установлен.

2. Выделить необходимые ячейки
3. Нажать комбинацию клавиш alt+f8 и запустить макрос «CreateWordFile»
4. Откроется окно выбора Word файла, на основе которого нужно сформировать документ
5. После нажатия кнопки «Открыть», откроется копия Word файла с вставленными значениями
Для примера выше, результат будет такой:
Нажмите на изображение для увеличения
Название: 2.jpg
Просмотров: 50
Размер:	10.0 Кб
ID:	5410Название: 3.jpg
Просмотров: 242

Размер: 8.4 Кб
Замечание: если в столбце выделено несколько ячеек, подставятся только значения первой из них.

EDIT:
Как в комментариях отметил stroyer, в word есть стандартный инструмент "создание писем". Он значительно проще и подойдет большинству. Сравнение способов в комментариях
Размещено в Без категории
Просмотров 257 Комментарии 2
Всего комментариев 2
Комментарии
  1. Старый комментарий
    Есть же инструмент "создание писем"? Более гибкий и более богатый. Не требующий наворачивания макросов
    Запись от stroyer размещена 22.07.2019 в 22:14 stroyer вне форума
  2. Старый комментарий
    Цитата:
    Сообщение от stroyer Просмотреть комментарий
    Есть же инструмент "создание писем"? Более гибкий и более богатый. Не требующий наворачивания макросов
    Гибкий и богатый - это спорно. как в нем в один файл вывести данные из нескольких строк?
    Что делать, если шаблоны документов общие на несколько сотрудников, а Excel базы у каждого своя?(в "создании писем" достаточно жестко зашивается путь к файлу и колонкам)

    С макросом этих проблем нет.

    Но: "Создание писем" в разы проще. И 90% случаев будет лучшим решением попробовать сначала его, потом макрос.
    Запись от setood размещена Вчера в 05:18 setood вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru