Несколько трюков в одном примере
В данном подразделе мы объединим рассмотренные выше трюки в один пример, а также несколько расширим его дополнительной возможностью. Иначе говоря, реализовав данный пример, можно будет быстро получить следующие результаты: подсчитать количество примечаний в текущей рабочей книге, выделить ячейки с примечаниями, отобразить сразу все примечания, вывести список примечаний текущей рабочей книги в отдельную книгу Excel и выбрать цветовую палитру для примечаний.
В первую очередь необходимо написать код, который приведен в листинге 3.39, и поместить его в редакторе VBA в стандартный модуль.
Листинг 3.39. Операции с примечаниями
Sub CountOfComments()
Dim intCommentCount As Integer
' Получение и отображение количества примечаний
intCommentCount = ActiveSheet.Comments.Count
If intCommentCount = 0 Then
MsgBox «Текущая рабочая книга не содержит примечаний.», _
vbInformation
Else
MsgBox "В текущей рабочей книге содержится " &
intCommentCount _
& « комментариев.», vbInformation
End If
End Sub
Sub SelectComments()
' Выделение всех ячеек с примечаниями
Cells.SpecialCells(xlCellTypeComments).Select
End Sub
Sub ShowComments()
' Отображение всех примечаний
If Application.DisplayCommentIndicator =
xlCommentAndIndicator Then
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Else
Application.DisplayCommentIndicator = xlCommentAndIndicator
End If
End Sub
Sub ListOfCommentsToFile()
Dim rgCells As Range ' Ячейки с примечаниями
Dim intDefListCount As Integer ' Используется для временного _ хранения количества
листов в книге по умолчанию
Dim strSheet As String ' Имя анализируемого листа
Dim strWorkBook As String ' Имя книги с анализируемым
листом
Dim intRow As Integer
Dim cell As Range
' Получение ячеек с примечаниями
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 – предназначен для быстрого отображения/скрытия одновременно всех примечаний.
В принципе, после написания кода можно сохранить текущий документ – он готов для дальнейшего использования. Однако для удобства работы лучше поместить в любое удобное место интерфейса кнопки и назначить каждой кнопке свой макрос из перечисленных выше. После этого для получения результата достаточно будет нажать соответствующую кнопку.