Создание списка панелей инструментов и контекстных меню

Автоматическое создание документов 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

Листинг 3.89. Список панелей инструментов и контекстных меню

Sub ListOfMenues()

Dim intRow As Integer ' Хранит текущую строку

Dim cbrBar As CommandBar

' Очистка всех ячеек текущего листа

Cells.Clear

intRow = 1 ' Начинаем запись с первой строки

' Просматриваем список панелей инструментов и меню _

и записываем информацию о каждом элементе в таблицу

For Each cbrBar In CommandBars

' Порядковый номер

Cells(intRow, 1) = cbrBar.Index

' Название

Cells(intRow, 2) = cbrBar.Name

' Тип

Select Case cbrBar.Type

Case msoBarTypeNormal

Cells(intRow, 3) = "Панель инструментов"

Case msoBarTypeMenuBar

Cells(intRow, 3) = "Строка меню"

Case msoBarTypePopup

Cells(intRow, 3) = "Контекстное меню"

End Select

' Встроенный элемент или созданный пользователем

Cells(intRow, 4) = cbrBar.BuiltIn

' Переходим на следующую строку

intRow = intRow + 1

Next

End Sub

Дата добавления: 2015-06-25