листе рабочей книги
intNamesCount = Names.Count
If intNamesCount = 0 Then
MsgBox «Имен нет»
Else
MsgBox "Имен: " & intNamesCount & « шт.»
End If
End Sub
Быстрый поиск курсора
Для быстрого поиска активной ячейки можно воспользоваться таким макросом (листинг 3.31).
Sub FindActiveCell()
' Выводим адрес активной ячейки
MsgBox ActiveCell.Address
End Sub
Результат поиска выводится в информационном окне, пример которого представлен на рис. 3.9.
Рис. 3.9. Адрес активной ячейки
Чтобы убрать значение абсолютной ссылки на строку и столбец, можно использовать следующий код:
MsgBox ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Поиск начала и окончания диапазона, содержащего данные
Аналогичным образом можно быстро определить диапазон листа, в котором содержатся какие-либо данные. Этот трюк удобно применять, например, когда данные разбросаны по всему листу и точно не известно, где они начинаются и где заканчиваются (а вручную просматривать весь лист долго и неудобно). Для решения подобной задачи можно применить следующий макрос (листинг 3.32).
Sub FindSheetData()
' Выводим диапазон используемых ячеек листа
MsgBox ActiveSheet.UsedRange.Address
End Sub
В результате выполнения макроса на экране появится окно, аналогичное изображенному на рис. 3.9, в котором будет указан соответствующий диапазон рабочего листа.
Если же необходимо определить не весь диапазон с данными, а найти лишь его начало, то можно воспользоваться макросом, код которого приведен в листинге 3.33.
Sub FindStartOfData()
With ActiveSheet
' Заносим текст в ячейку, являющуюся левой верхней _
ячейкой используемого диапазона
.Cells(.UsedRange.Row, .UsedRange.Column).Value = _
«Начало данных»
End With
End Sub
После выполнения данного макроса в левой верхней ячейке диапазона, содержащего данные, отобразится текст Начало данных (этот текст можно изменять по своему усмотрению). Подобный трюк удобно применять при работе с большими объемами данных, когда они разбросаны по всему рабочему листу и трудно определить точное место их начала (особенно если первые данные диапазона находятся, например, в ячейке Т350).
Трюки с примечаниями
В данном разделе мы рассмотрим, каким образом можно быстро определить наличие на рабочем листе примечаний и подсчитать их, а также вывести их в виде текста в ячейку справа либо в отдельный список.
Подсчет примечаний
По умолчанию ячейки, содержащие примечания, помечаются соответствующим индикатором, который расположен в правом верхнем углу ячейки (обычно это красный треугольник). Однако если примечание скрыто и ячейка, к которой оно создано, ничем не отличается от остальных ячеек рабочего листа, то, чтобы определить, имеются ли на текущем рабочем листе примечания, и подсчитать их количество, можно написать и выполнить следующий макрос (листинг 3.34).
Sub CountOfComment()
Dim intCommentCount As Integer
' Получение и отображение количества примечаний _
на текущем листе
intCommentCount = ActiveSheet.Comments.Count
If intCommentCount = 0 Then
MsgBox «Примечаний нет»
Else
MsgBox "Примечаний: " & intCommentCount & « шт.»
End If
End Sub
В результате применения макроса на экране отобразится окно, аналогичное изображенному на рис. 3.9, в котором будет показано количество содержащихся на текущем листе примечаний.
Вывод на экран всех примечаний рабочего листа
Применив несложный трюк, можно вывести все примечания, содержащиеся на рабочем листе или в выделенном его диапазоне, в ячейки, расположенные справа от соответствующих примечаний. Решить эту задачу поможет такой макрос (листинг 3.35).
Sub ShowComments()
Dim cell As Range
Dim rgCells As Range
' Получение всех ячеек с примечаниями
Set rgCells = Selection.SpecialCells(xlComments)
If rgCells Is Nothing Then
' Примечаний нет
Exit Sub
End If
' Проходим по всем ячейкам диапазона
For Each cell In rgCells
' Вывод примечаний в соседнюю ячейку
cell.Next.Value = cell.Comment.Text
Next
End Sub
Данный макрос можно применять как к предварительно выделенному диапазону, так и к рабочему листу целиком.
Примечание
Если рабочий лист защищен, то данный макрос работать не будет.
Для защищенных (а также остальных) рабочих листов можно применить такой макрос (листинг 3.36).
Sub ShowComments1()
Dim cell As Range
Dim strFirstAddress As String
Dim strComments As String
' Получаем все ячейки выделения, в которых есть комментарий
Set cell = Selection.Find("*", LookIn:=xlComments)
If Not cell Is Nothing Then
' Сохранение адреса первой найденной ячейки _
(для предотвращения зацикливания поиска)
strFirstAddress = cell.Address
Do
' Добавление текста примечания в выходную строку
strComments = strComments & "Комментарий: " & _
cell.Comment.Text & Chr(13)
' Продолжение поиска
Set cell = Selection.FindNext(cell)
Loop While Not cell Is Nothing And _
cell.Address <> strFirstAddress
End If
If strComments <> "" Then
' Отображение окна с текстом примечаний
MsgBox strComments
Else
MsgBox «В выделенной ячейке/ячейках комментариев нет»
End If
End Sub
Данный макрос работает только с предварительно выделенным диапазоном рабочего листа.
Создание списка примечаний рабочего листа
Все имеющиеся на рабочем листе примечания можно вывести в виде отдельного списка, например, в столбце С. Соответствующий макрос выглядит следующим образом (листинг 3.37).
Sub ListOfComments()
Dim cell As Range
Dim rgCells As Range
Dim intRow As Integer
' Получение всех ячеек с примечаниями
On Error Resume Next
Set rgCells = Selection.SpecialCells(xlComments)
If rgCells Is Nothing Then
' Примечаний нет
Exit Sub
End If
' Проходим по всем ячейкам диапазона
For Each cell In rgCells
' Вывод примечаний в ячейку столбца "C"
intRow = intRow + 1
Cells(intRow, 3) = cell.Comment.Text
Next
End Sub
К аналогичному результату (вывод примечаний в виде списка в столбце С) приведет написание и использование такого макроса (листинг 3.38).
Sub ListOfComments1()
Dim cell As Range
Dim strFirstAddress As String
Dim intRow As Integer
' Получение всех ячеек выделения, в которых есть примечания
Set cell = Cells.Find("*", LookIn:=xlComments)
If Not cell Is Nothing Then
' Сохранение адреса первой найденной ячейки _
(для предотвращения зацикливания поиска)
strFirstAddress = cell.Address
Do
' Вывод текста в столбец "C"
intRow = intRow + 1
Cells(intRow, 3) = cell.Comment.Text
' Продолжение поиска
Set cell = Cells.FindNext(cell)
Loop While Not cell Is Nothing And _
cell.Address <> strFirstAddress
End If
End Sub
Следует отметить, что столбец С взят только для примера.
Несколько трюков в одном примере
В данном подразделе мы объединим рассмотренные выше трюки в один пример, а также несколько расширим его дополнительной возможностью. Иначе говоря, реализовав данный пример, можно будет быстро получить следующие результаты: подсчитать количество примечаний в текущей рабочей книге, выделить ячейки с примечаниями, отобразить сразу все примечания, вывести список примечаний текущей рабочей книги в отдельную книгу Excel и выбрать цветовую палитру для примечаний.
В первую очередь необходимо написать код, который приведен в листинге 3.39, и поместить его в редакторе VBA в стандартный модуль.
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 – предназначен для быстрого отображения/скрытия одновременно всех примечаний.
В принципе, после написания кода можно сохранить текущий документ – он готов для дальнейшего использования. Однако для удобства работы лучше поместить в любое удобное место интерфейса кнопки и назначить каждой кнопке свой макрос из перечисленных выше. После этого для получения результата достаточно будет нажать соответствующую кнопку.