Главная страница Случайная страница
КАТЕГОРИИ:
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Вывод на экран всех примечаний рабочего листа
|
|
Листинг 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. Перечень примечаний в отдельном списке (вариант 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. Перечень примечаний в отдельном списке (вариант 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"
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