Список примечаний защищенных листов

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

Перечень примечаний в отдельном списке_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

Перечень примечаний в отдельном списке_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

Перечень примечаний в отдельном списке_3

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

 

Подсчет количества примечаний_1

Sub CountOfComments()

Dim intCommentCount As Integer

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

intCommentCount = ActiveSheet.Comments.Count

If intCommentCount = 0 Then

MsgBox "Текущая рабочая книга не содержит примечаний.", _

  vbInformation

Else

MsgBox "В текущей рабочей книге содержится " & intCommentCount _

  & " комментариев.", vbInformation

End If

End Sub

Подсчет количества примечаний_2

' Function IsCommentsPresent

 ' Возвращает TRUE, если на активном рабочем листе имеется хотя бы

 ' одна ячейка с комментарием, иначе возвращает FALSE

 '

 Public Function IsCommentsPresent() As Boolean

IsCommentsPresent = (ActiveSheet.Comments.Count <> 0)

 End Function

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

Sub CountOfComment()

Dim intCommentCount As Integer

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

на текущем листе

 intCommentCount = ActiveSheet.Comments.Count

If intCommentCount = 0 Then

MsgBox "Примечаний нет"

Else

MsgBox "Примечаний: " & intCommentCount & " шт."

End If

End Sub