Вывод на экран всех примечаний рабочего листа

Подсчет примечаний

Поиск начала и окончания диапазона, содержащего данные

Быстрый поиск курсора

Подсчет именованных объектов

Листинг 3.29. Количество именованных объектов

Sub CountNames()

Dim intNamesCount As Integer

' Получаем и отображаем количество имен в активной _

рабочей книге

intNamesCount = ActiveWorkbook.Names.Count

If intNamesCount = 0 Then

MsgBox "Имен нет"

Else

MsgBox "Имен: " & intNamesCount & " шт."

End If

End Sub

Листинг 3.30. Количество имен рабочей книги

Sub CountNames()

Dim intNamesCount As Integer

' Получаем и отображаем количество имен на активном _

листе рабочей книги

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.32. Поиск данных

Sub FindSheetData()

' Выводим диапазон используемых ячеек листа

MsgBox ActiveSheet.UsedRange.Address

End Sub

Листинг 3.33. Поиск начала данных

Sub FindStartOfData()

With ActiveSheet

' Заносим текст в ячейку, являющуюся левой верхней _

ячейкой используемого диапазона

.Cells(.UsedRange.Row,.UsedRange.Column).Value = _

"Начало данных"

End With

End Sub

Трюки с примечаниями

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

Дата добавления: 2015-06-25