Автоматическое создание документов Word на основе табличных данных Excel

Листинг 3.88. Создание документов Word на основе таблицы Excel

Sub ReportToWord()

Dim intReportCount As Integer ' Количество сообщений

Dim strForWho As String ' Получатель сообщения

Dim strSum As String ' Сумма за товар

Dim strProduct As String ' Название товара

Dim strOutFileName As String ' Имя файла для сохранения сообщения

Dim strMessage As String ' Текст дополнительного сообщения

Dim rgData As Range ' Обрабатываемые ячейки

Dim objWord As Object

Dim i As Integer

' Создание объекта Word

Set objWord = CreateObject(" Word.Application")

' Информация с рабочего листа

Set rgData = Range(" A1")

strMessage = Range(" E6")

' Просмотр записей на листе Лист1

intReportCount = Application.CountA(Range(" A: A"))

For i = 1 To intReportCount

' Динамические сообщения в строке состояния

Application.StatusBar = " Создание сообщения " & i

' Назначение данных переменным

strForWho = rgData.Cells(i, 1).Value

strProduct = rgData.Cells(i, 2).Value

strSum = Format(rgData.Cells(i, 3).Value, " #, 000")

' Имя файла для сохранения отчета

strOutFileName = ThisWorkbook.path & " \" & strForWho & ".doc"

' Передача команд в Word

With objWord

.Documents.Add

With.Selection

' Заголовок сообщения

.Font.Size = 14

.Font.Bold = True

.ParagraphFormat.Alignment = 1

.TypeText Text: =" О Т Ч Е Т"

' Дата

.TypeParagraph

.TypeParagraph

.Font.Size = 12

.ParagraphFormat.Alignment = 0

.Font.Bold = False

.TypeText Text: =" Дата: " & vbTab & _

Format(Date, " mmmm d, yyyy")

' Получатель сообщения

.TypeParagraph

.TypeText Text: =" Кому: менеджеру " & vbTab & strForWho

' Отправитель

.TypeParagraph

.TypeText Text: =" От: " & vbTab & Application.UserName

' Сообщение

.TypeParagraph

.TypeParagraph

.TypeText strMessage

.TypeParagraph

.TypeParagraph

' Название товара

.TypeText Text: =" Продано товара: " & vbTab & strProduct

.TypeParagraph

' Сумма за товар

.TypeText Text: =" На сумму: " & vbTab & _

Format(strSum, " $#, ##0")

End With

' Сохранение документа

.ActiveDocument.SaveAs FileName: =strOutFileName

End With

Next i

' Удаление объекта Word

objWord.Quit

Set objWord = Nothing

' Обновление строки состояния

Application.StatusBar = False

' Вывод на экран информационного сообщения

MsgBox intReportCount & " заметки создано и сохранено в папке " _

& ThisWorkbook.path

End Sub