Excel. Трюки и эффекты | страница 105



Next

End Sub

Данный макрос можно применять как к предварительно выделенному диапазону, так и к рабочему листу целиком.

Примечание

Если рабочий лист защищен, то данный макрос работать не будет.

Для защищенных (а также остальных) рабочих листов можно применить такой макрос (листинг 3.36).

Листинг 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).

Листинг 3.37. Перечень примечаний в отдельном списке (вариант 1)

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).

Листинг 3.38. Перечень примечаний в отдельном списке (вариант 2)

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"