On Error Resume Next
Set rgCells = ActiveSheet.Cells.SpecialCells(xlComments)
On Error GoTo 0
' Если примечаний нет, то можно не продолжать
If rgCells Is Nothing Then
MsgBox «Текущая рабочая книга не содержит примечаний.», _
vbInformation
Exit Sub
End If
' Сохранение имен анализируемого листа и книги
strSheet = ActiveSheet.Name
strWorkBook = ActiveWorkbook.Name
' Создание отдельной книги с одним листом _
для отображения результатов
intDefListCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = intDefListCount
ActiveWorkbook.Windows(1).Caption = "Comments for " &
strSheet & _
" in " & strWorkBook
' Создание списка примечаний
Cells(1, 1) = «Адрес»
Cells(1, 2) = «Содержимое»
Cells(1, 3) = «Комментарий»
Range(Cells(1, 1), Cells(1, 3)).Font.Bold = True
intRow = 2 ' Данные начинаются со второй строки
For Each cell In rgCells
Cells(intRow, 1) = cell.Address(rowabsolute:=False, _
columnabsolute:=False)
Cells(intRow, 2) = " " & cell.Formula
Cells(intRow, 3) = cell.comment.Text
intRow = intRow + 1
Next
End Sub
Sub ChangeCommentColor()
' Автоматическое изменение цвета комментариев
Dim comment As comment
For Each comment In ActiveSheet.Comments
' Задаем случайные цвета заливки и шрифта комментариев
comment.Shape.Fill.ForeColor.SchemeColor = Int((80) * Rnd + 1)
comment.Shape.TextFrame.Characters.Font.ColorIndex =
Int((56 _
) * Rnd + 1)
Next
End Sub
В результате написания данного кода в окне выбора макросов будут доступны следующие макросы:
• ChangeCommentColor – с помощью этого макроса назначается произвольная цветовая палитра, используемая для оформления примечаний;
• CountOfComments – подсчитывает количество примечаний;
• ListOfCommentsToFile – выводит список примечаний в отдельный файл (при этом для каждой позиции списка в соответствующих столбцах отображается адрес ячейки, ее содержимое и текст примечания);
• SelectComments – выделяет ячейки с примечаниями;
• ShowComments – предназначен для быстрого отображения/скрытия одновременно всех примечаний.
В принципе, после написания кода можно сохранить текущий документ – он готов для дальнейшего использования. Однако для удобства работы лучше поместить в любое удобное место интерфейса кнопки и назначить каждой кнопке свой макрос из перечисленных выше. После этого для получения результата достаточно будет нажать соответствующую кнопку.
Дополнение панели инструментов
При необходимости в состав настраиваемых панелей инструментов, которые находятся на вкладке Надстройки, можно добавлять пользовательские элементы управления (в частности, кнопки). Например, можно использовать следующий макрос (листинг 3.40).
Sub AddCustomButton()
' Добавление кнопки на панель инструментов
With Application.Toolbars(1).ToolbarButtons.Add(button:=222)
.Name = «Кнопка»
.OnAction = «Макрос»
End With
End Sub
Кнопка, добавленная на стандартную панель инструментов в результате применения этого макроса, показана на рис. 3.10.
Рис. 3.10. Добавление пользовательской кнопки
Примеры создания панелей инструментов