strMessage = «Принтер:» & Chr(9) & strPrinter & Chr(13)
strMessage = strMessage & «Драйвер:» & strDriver & Chr(13)
strMessage = strMessage & «strPort:» & Chr(9) & strPort
' Вывод информационного сообщения
MsgBox strMessage, vbInformation, «Сведения о принтере по умолчанию»
End Sub
В данном примере для получения информации о принтере используется API-функция GetProf ileStringA. Эта функция возвращает в строку-буфер strFullInf о информацию в виде <имяпринтера>, <драйвер>, <порт>:.
После запуска данного макроса на экран выводится окно Сведения о принтере по умолчанию (название окна можно корректировать по своему усмотрению путем внесения соответствующих изменений в код макроса), в котором будет показана марка принтера, а также его драйвер и порт.
Вывод текущей даты и времени
Применив несложный трюк, можно в любой момент вывести на экран окно с информацией о текущей дате и времени. Для достижения такого эффекта достаточно написать и запустить макрос, код которого выглядит следующим образом (листинг 3.84).
Sub TimeAndDate()
Dim strDate As String, strTime As String
Dim strGreeting As String
Dim strUserName As String
Dim intSpacePos As Integer
strDate = Format(Date, «Long Date»)
strTime = Format(Time, «Medium Time»)
' Приветствие – в зависимости от времени суток
If Time < TimeValue(«12:00») Then
strGreeting = "Доброе утро, "
ElseIf Time < TimeValue(«17:00») Then
strGreeting = "Добрый день, "
Else
strGreeting = "Добрый вечер, "
End If
' В приветствие добавляется имя текущего пользователя
strUserName = Application.UserName
intSpacePos = InStr(1, strUserName, " ", 1)
' Управление ситуацией, когда в имени нет пробела
If intSpacePos = 0 Then intSpacePos = Len(strUserName)
strGreeting = strGreeting & Left(strUserName, intSpacePos)
' Вывод на экран информационного сообщения о дате и времени
MsgBox strDate & vbCrLf & strTime, vbOKOnly, strGreeting
End Sub
После каждого выполнения данного макроса на экране будет отображаться окно с информацией о текущей дате и времени. В заголовке окна, помимо имени пользователя, будет содержаться текст Доброе утро, Добрый день либо Добрый вечер (в зависимости от времени суток).
Автоматическое создание документов Word на основе табличных данных Excel
В данном разделе мы рассмотрим трюк, с помощью которого можно автоматически создавать текстовые документы Word на основе данных, хранящихся в таблице Excel. Это бывает необходимо, например, для быстрого формирования текстовых отчетов, в которых должны фигурировать табличные данные. Использование этого приема мы рассмотрим на конкретном примере.
Предположим, что у нас есть следующие данные о продажах по регионам (рис. 3.31).
Внимание!
При изучении данного раздела следует обращать внимание на расположение данных на рабочем листе (то есть на координаты задействованных ячеек).
Для автоматического создания отчетов на основании приведенных данных следует в стандартном модуле редактора VBA написать код, приведенный в листинге 3.85.
Рис. 3.31. Данные о продажах
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
В результате написания кода в окне выбора макросов станет доступным макрос ReportToWord. После его запуска начнется формирование отчетов (информация о состоянии процесса будет отображаться в строке состояния). По окончании процесса на экране отобразится окно с сообщением о том, что документы сформированы и помещены в ту папку, в которой хранится текущая рабочая книга. В рассматриваемом примере будут созданы три документа с именами Магазин 1.doc, Магазин 2.doc и Магазин 3.doc. Содержимое документа Магазин 1. doc показано на рис. 3.32 (другие документы выглядят аналогичным образом).
В рассматриваемом примере Lesha – это имя пользователя, который создал документ. Очевидно, что в результате внесения соответствующих изменений в код макроса форму создаваемого отчета можно корректировать по своему усмотрению.
Рис. 3.32. Документ Word, созданный на основе данных таблицы Excel
Создание списка панелей инструментов и контекстных меню
При необходимости можно сформировать на рабочем листе список доступных панелей инструментов и контекстных меню. Для этого достаточно написать (в стандартном модуле редактора VBA) и запустить на выполнение макрос, код которого приведен в листинге 3.86.
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
Результат выполнения данного макроса (после написания кода он будет доступен в окне списка макросов) показан на рис. 3.33.
Рис. 3.33. Фрагмент списка панелей инструментов и меню
Данный список выводится на активном рабочем листе.
Создание списка пунктов главного меню Excel
Подобным образом можно сформировать список подменю и команд, входящих в главное меню (которое существовало в более ранних версиях программы). Для этого в стандартном модуле VBA необходимо написать следующий код (листинг 3.87).
Sub ListOfMenues()
Dim intRow As Integer ' Текущая строка, куда идет запись
Dim cbrcMenu As CommandBarControl ' Главное меню
Dim cbrcSubMenu As CommandBarControl ' Подменю
Dim cbrcSubSubMenu As CommandBarControl ' Подменю в подменю
' Очищаем ячейки текущего листа
Cells.Clear
' Начинаем запись с первой строки
intRow = 1
' Просматриваем все элементы строки меню
On Error Resume Next ' Игнорируем ошибки
For Each cbrcMenu In CommandBars(1).Controls
' Просматриваем элементы выпадающего меню cbrcMenu
For Each cbrcSubMenu In cbrcMenu.Controls
' Просматриваем элементы подменю cbrcSubMenu
For Each cbrcSubSubMenu In cbrcSubMenu.Controls
' Выводим название главного меню
Cells(intRow, 1) = cbrcMenu.Caption
' Выводим название подменю
Cells(intRow, 2) = cbrcSubMenu.Caption
' Выводим название вложенного подменю