Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Примечания (Комментарии)


Rambler's Top100


Counter CO.KZ


Предисловие : Об'ект Comment и метод AddComment появились только в MS Excel 97, поэтому, в MS Excel 95 необходимо использовать варианты, где используется NoteText.


  1. Как создать примечание / комментарий ? 06.08.2006
  2. Как создать примечание / комментарий, указав автора в макросе ? 08.08.2014
  3. Как создать "нестандартный" комментарий ? 06.08.2006
  4. Как определить наличие комментария или текста примечания в ячейке ? 06.08.2006
  5. Как получить текст примечания / комментария ? 06.08.2006
  6. Как изменить текст примечания / комментария ? 14.06.2008
  7. Как определить наличие примечаний в рабочем листе и их количество ? 03.04.2005
  8. Как определить наличие примечаний в определённом диапазоне и их количество [без цикла] ? 13.08.2006
  9. Как удалить все примечания / комментарии в рабочем листе [без цикла] ? 05.12.2014
  10. Как быстро найти нужный текст в примечаниях рабочего листа ? 06.01.2007
  11. Как вывести примечания (в виде текста), находящиеся в заранее выделенном диапазоне, в ячейку справа ? 06.05.2005
  12. Как вывести все примечания, находящиеся в рабочем листе в отдельный список, в виде текста ? 06.05.2005
  13. Как заархивировать примечания, находящиеся во всех рабочих листах активной книги, и при необходимости, восстановить их ? NEW 24.07.2016
  14. Как скопировать формат одного примечания и применить его к другим примечаниям (тиражирование формата комментария) ? 12.06.2008
  15. Как программно отображать примечание при активации ячейки ? 21.06.2007
  16. Как программно отобразить или скрыть все примечания ? 27.03.2011
  17. Как программно изменить размер (ширина, высота) всех примечаний в рабочем листе ? NEW 23.07.2016
  18. Как суммировать данные только тех ячеек, которые имеют примечание, содержащее определённый(нужный) текст ? 02.12.2007
  19. Как в тексте примечания найти и исправить слова, написанные с ошибками, с помощью проверки орфографии ? 07.03.2010
  20. Как создать комментарий, содержащий время последнего пересчёта нужной пользовательской функции ? 01.07.2007
  21. Как при изменении данных в ячейках определённого диапазона - автоматически добавить примечание с датой и временем этого изменения ? 18.03.2007
  22. Как программно создать/прочитать комментарий к "умной" таблице ? NEW 17.05.2017

  • Ответ :

    Вариант I.
  • Range("A1").NoteText Text:="Отправка груза задерживается"
    Комментарий :
  • Если ячейка уже содержит комментарий, то использование этого варианта приведёт к замене старого текста на новый.
  • Если текст нового примечания содержит более 255 символов, то ничего не произойдёт.
  • Для того, чтобы создать примечание содержащее более 255 символов необходимо использовать :
  • iNote = Application.Rept("Добро пожаловать на сайт ", 25)

    For iCount = 1 To Len(iNote) Step 255
        Range("A1").NoteText Text:=Mid(iNote, iCount, 255), Start:=iCount
    Next
    Вариант II.
    Range("A1").AddComment Text:="Груз отправлен : " & Date$

    Range("A1").AddComment(Text:="Груз ушёл").Visible = True

    Range("A1").AddComment.Text "Груз отправлен сегодня в " & Time$
    Комментарий :
  • Если ячейка уже содержит комментарий, то использование этого варианта приведёт к возникновению ошибки, которую можно избежать, если сначала проверить наличие комментария, используя [FAQ118] или предварительно удалить примечание, используя метод ClearNotes или ClearComments
  • Range("A1").ClearNotes '.ClearComments
    Range("A1").AddComment Text:="http://www.msoffice.nm.ru/"
    With ThisWorkbook.Worksheets(1).Range("A1")
         .ClearComments '.ClearNotes
         With .AddComment
              .Text Text:="Звонок в ТрансСервис"
              With .Shape
                   .Line.ForeColor.SchemeColor = 24
                   .Fill.ForeColor.SchemeColor = 40
                   With .TextFrame
                        .VerticalAlignment = xlVAlignCenter
                        .HorizontalAlignment = xlHAlignCenter
                        .Orientation = msoTextOrientationHorizontal
                        .Characters.Font.Bold = True
                   End With
              End With
              .Visible = True
         End With
    End With

  • Ответ :

    Если выделить ячейку, которая содержит примечание/комментарий, то в строке состояния Вы увидите текст, который несколько различается в зависимости от версии, однако в любом случае содержит адрес ячейки, а главное, автора примечания/комментария :

    95-2000 Ячейка A1 комментируется Иванов С.Г.
    XP-2003 Ячейка A1, автор примечания: Иванов С.Г.

    Автором же примечания (при его создании) считается пользователь, который был "указан" в меню Сервис команда Параметры закладка Общие и поле Имя пользователя: И если Вас не это устраивает и Вы хотите видеть автором другого человека(пользователя/компанию), то используйте любой из двух нижеопубликованных макросов, разумеется указав свою ячейку, а также текст и автора примечания.

    Вариант I.
  • Private Sub CellAddNote()
         Dim iUserName$: iUserName = Application.UserName

         Application.UserName = "Сусликов Б.С."

         Range("A1").ClearNotes
         Range("A1").NoteText Text:="Примечание с новым автором"

         Application.UserName = iUserName
    End Sub
    Вариант II.
    Private Sub CellAddComment()
         Dim iUserName$: iUserName = Application.UserName

         Application.UserName = "Сусликов Б.С."

         Range("A2").ClearComments
         Range("A2").AddComment Text:="Комментарий с новым автором"

         Application.UserName = iUserName
    End Sub

  • Ответ :
  • Range("A1").AddComment.Shape.AutoShapeType = msoShapeSmileyFace
    Range("A1").AddComment(Text:="Заметка").Shape.AutoShapeType = msoShape32pointStar
    With ThisWorkbook.Worksheets(1).Range("A1")
         .ClearComments
         With .AddComment
              .Visible = True
              '.Text Text:="Не забыть позвонить в Кремль"
              With .Shape
                   .AutoShapeType = msoShapeVerticalScroll
                  
                   .Fill.ForeColor.SchemeColor = 22
                   .Fill.BackColor.SchemeColor = 9
                   .Fill.TwoColorGradient msoGradientFromCenter, 2
              End With
         End With
    End With
    Автофигуры для комментария [Microsoft Excel 97, 2000] Скачать Скачать
  • Ответ :

    Вариант I.
  • If Range("A1").Comment Is Nothing Then
       MsgBox "Ячейка не содержит примечание"
    Else
       MsgBox "Ячейка содержит примечание"
    End If

    If Not Range("A1").Comment Is Nothing Then
       MsgBox "Ячейка содержит примечание"
    Else
       MsgBox "Ячейка не содержит примечание"
    End If
    Вариант II.
    On Error Resume Next

    Dim iCell As Range

    Set iCell = Range("A1").SpecialCells(xlComments)

    If Not iCell Is Nothing Then
       MsgBox "Ячейка содержит примечание"
    Else
       MsgBox "Ячейка не содержит примечание"
    End If
    Вариант III.
    If Not Range("A1").Find(What:="*", LookIn:=xlComments) Is Nothing Then
       MsgBox "Ячейка содержит примечание"
    Else
       MsgBox "Ячейка не содержит примечание ..." & _
       vbCrLf & "или примечание не содержит текста"
    End If
    Вариант IV.
    If Range("A1").NoteText <> "" Then
       MsgBox "Ячейка содержит примечание"
    Else
       MsgBox "Ячейка не содержит примечание ..." & _
       vbCrLf & "или примечание не содержит текста"
    End If
    Вариант V.
    On Error Resume Next

    For Each iCell In Range("A1:A5")
        iCommentText = iCell.Comment.Text
        If Not IsEmpty(iCommentText) Then
           MsgBox iCommentText, vbExclamation, iCell.Address
        Else
           MsgBox "Ячейка не содержит примечания", , iCell.Address
        End If: iCommentText = Empty
    Next
    Примечание :
  • - Если рабочий лист защищён, то второй макрос работать не будет, если Вы не будете использовать этот [FAQ42]
  • Ответ :

    Вариант I.
  • iNoteText = Range("A1").NoteText
    MsgBox iNoteText
    Комментарий :
  • Если текст примечания содержит более 255 символов, то Вы получите только первые 255 символов, для получения всего текста, можно использовать :
  • Do
         iTempText$ = Range("A1").NoteText(Start:=iCount% * 255 + 1)
         iNoteText$ = iNoteText$ & iTempText$
         iCount% = iCount% + 1
    Loop While iTempText$ <> ""

    MsgBox iNoteText$
    Вариант II.
    If Range("A1").NoteText <> "" Then
       iCommentText = Range("A1").Comment.Text
       MsgBox iCommentText
    End If
    If Not Range("A1").Comment Is Nothing Then
       iCommentText = Range("A1").Comment.Text
       MsgBox iCommentText
    End If
    Если необходимо получить текст комментария или информацию о наличии комментария непосредственно с помощью формул, то Вы можете использовать пользовательскую функцию :
    Function GetComment(iCell, Optional iInformation)
    '***********************************************'
    '   Дата создания 01/01/2005
    '   Автор Климов Павел Юрьевич
    '   http://www.msoffice.nm.ru
    '***********************************************'
        Application.Volatile True
        iPresence = Not iCell(1).Comment Is Nothing
        If IsMissing(iInformation) = True Then
           If iPresence = True Then
              GetComment = iCell(1).Comment.Text
           Else
              GetComment = "<>"
           End If
        Else
           GetComment = iPresence
        End If
    End Function
    Пример вызова вышеопубликованной авторской функции :
    =GetComment(A1)
    =GetComment(A1;"Yes")

  • Ответ :

    Для того, чтобы изменить текст примечания, можно сначала извлечь уже существующий текст [FAQ119], затем внести необходимые изменения (применив соответствующие функции), после чего, в зависимости от способа получения текста, использовать один из двух нижеприведённых вариантов ( если текст содержит более 255 символов, но при этом, Вы выбрали именно первый способ, то рекомендую посетить сей [FAQ117] )

    Вариант I.
  • Range("A1").NoteText Text:=iNewText
    Вариант II.
    Range("A1").Comment.Text Text:=iNewText
    Однако, в некоторых случаях, например, при замене/удалении текста, который начинается с определённой позиции и содержит некоторое количество символов, или при замене всех (или только первого, второго и т.д.) встречающихся в тексте слов/выражений, можно обойтись без лишних действий и использовании переменной.

    Пример I, предположим, что в ячейке "A1" находится примечание, содержащее следующий текст "Отправка груза задерживается" в котором слово "задерживается" должно быть заменено на "произошла"

    Вариант I.
    Range("A1").NoteText Text:="произошла", Start:=16, Length:=13
    Вариант II.
    Range("A1").Comment.Text Text:="произошла", Start:=16, Overwrite:=13

    Range("A1").Comment.Shape.TextFrame.Characters(Start:=16, Length:=13).Text = "произошла"
    Комментарий : Рекомендую использовать необязательные именованные аргументы Length и Overwrite в тех случаях, когда необходимо сохранить текст, который может находиться после заменяемого.

    Пример II, предположим, что в ячейке "A1" находится примечание, содержащее следующий текст "Отправка груза произошла. /Сусликов Б.С./" и нам необходимо избавиться от подписи, т.е. "/Сусликов Б.С./"

    Вариант I.
    Range("A1").NoteText Text:="", Start:=27 ', Length:=15

    With Range("A1")
         .NoteText Application.Substitute(.NoteText, "/Сусликов Б.С./", "")
    End With
    Вариант II.
    Range("A1").Comment.Shape.TextFrame.Characters(Start:=27, Length:=15).Delete

    With Range("A1").Comment
         .Text = Application.Substitute(.Text, "/Сусликов Б.С./", "")
    End With
    Комментарий : Обратите внимание на то, в каждом варианте используются два принципиально разных подхода к удалению ненужного текста, и если первый способ требует от нас точного указания позиции, то второй способ позволяет удалить сразу все ненужные вхождения. Впрочем, при необходимости, можно и указать номер вхождения, который требуется удалить(заменить), т.е. воспользоваться необязательным четвёртым и пятым аргументом соответственно.
    Application.Substitute(Arg1, Arg2, Arg3, [Arg4])
    Replace(Expression, Find, Replace[, Start[,  Count[, Compare]]])
    Пример III, предположим, что в ячейке "A1" находится примечание, содержащее следующий текст "Отправка груза, типа, произошла. Ответственный, типа, Климов П.Ю." и нам необходимо избавиться от слов-паразитов, в данном случае "типа"

    Вариант I.
    Range("A1").NoteText Replace(Range("A1").NoteText, ", типа,", "") 'XL2000

    With Range("A1")
         .NoteText Application.Substitute(.NoteText, ", типа,", "")
    End With
    Вариант II.
    With Range("A1").Comment
         .Text Application.Substitute(.Text, ", типа,", "")
    End With

    With Range("A1").Comment.Shape.TextFrame.Characters
         .Text = Application.Substitute(.Text, ", типа,", "")
    End With
    Примечание : Начиная с MS Excel 2000 стандартную функцию рабочего листа Application.Substitute можно заменить на VB(A) функцию Replace

    Пример IV, предположим, что в ячейке "A1" находится примечание, содержащее некий текст, который необходимо дополнить следующим текстом "Добавлено : " Т.е. новый текст необходимо вставить в самое начало примечания, но при этом, не удалить уже имеющейся текст.

    Вариант I.
    Range("A1").NoteText Text:="Добавлено : ", Start:=1, Length:=0

    Range("A1").NoteText "Добавлено : " & Range("A1").NoteText
    Вариант II.
    Range("A1").Comment.Text Text:="Добавлено : ", Start:=1, Overwrite:=0

    Range("A1").Comment.Text "Добавлено : " & Range("A1").Comment.Text
    Пример V, предположим, что в ячейке "A1" находится примечание, содержащее некий текст, в конец которого (причём с новой строки) нам нужно добавить следующий текст "Исправлено " & текущая_дата_время

    Вариант I.
    Range("A1").NoteText Range("A1").NoteText & vbLf & "Исправлено " & Now

    Range("A1").NoteText _
    vbLf & "Исправлено " & Now, Len(Range("A1").NoteText) + 1
    Вариант II.
    With Range("A1").Comment
         .Text Text:=.Text & Chr(10) & "Исправлено " & Now
    End With

    With Range("A1").Comment
         .Text vbLf & "Исправлено " & Now, Len(.Text) + 1
    End With

    With Range("A1").Comment.Shape.TextFrame
         .Characters(.Characters.Count + 1).Insert vbLf & "Исправлено " & Now
    End With

    With Range("A1").Comment.Shape.TextFrame
         .Characters(Len( _
         .Characters.Text) + 1).Insert Chr(10) & "Исправлено " & Now
    End With

  • Ответ :
  • iCommentCount = ActiveSheet.Comments.Count

    If iCommentCount = 0 Then
       MsgBox "Примечаний нет"
    Else
       MsgBox "Примечаний : " & iCommentCount & " шт."
    End If

  • Ответ : Скачать пример
  • Private Sub CommentsInRange()

    On Error Resume Next

    Dim iRangeComments As Range, iCell As Range

    With ThisWorkbook.Worksheets(1)
         If .ProtectContents = True Then
            .Protect UserInterfaceOnly:=True
         End If

         Set iRangeComments = .Range("A1:F30").SpecialCells(xlComments)

         If Not iRangeComments Is Nothing Then
            iCountComments& = iRangeComments.Count
            If MsgBox("В указанном диапазоне примечаний " & iCountComments& & " шт." & vbCrLf & _
               "Хотите ли Вы перебрать все ячейки содержащие примечания ?", vbYesNo) = vbYes Then
               For Each iCell In iRangeComments
                   MsgBox iCell.Comment.Text, , iCell.Address
               Next
            End If
         Else
            MsgBox "В указанном диапазоне примечаний нет"
         End If
    End With

    End Sub

  • Ответ :

    Для того, чтобы удалить все примечания / комментарии в рабочем листе, причём без цикла, можно использовать следующие методы :
  • ActiveSheet.UsedRange.ClearNotes
    Комментарий : Если рабочий лист защищён и хотя бы одна ячейка, также защищена, то Вы получите ошибку, если лист защищён, а ячейки нет, то ошибка не возникнет, но и примечания удалены не будут.
    ActiveSheet.UsedRange.ClearComments
    Комментарий : Если рабочий лист защищён, то комментарии удалены не будут.

    Примечание : Резюмируя, можно изречь следующее, если лист защищён, а комментарии / примечания удалить необходимо, то можно удалять их в цикле (см. семейство Comments)
  • Ответ :

    В данных примерах осуществляется поиск указанного текста во всех примечаниях нужного рабочего листа. Все примечания, содержащие искомый текст, будут отображены на экране.

    Нижеприведённый код необходимо разместить в модуле рабочего листа, где предполагается осуществить поиск примечаний. Если использование модуля листа нежелательно, то код можно разместить в стандартном модуле, обязательно заменив ключевое слово Me ссылкой на нужный рабочий лист.

    Вариант I.
  • Private Sub SearchTextInComments()
        iSearchText$ = "текст"

        Dim iCell As Range
        Set iCell = Me.UsedRange.Find _
        (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlPart)

        If Not iCell Is Nothing Then
           iAddress$ = iCell.Address
           Do
                iCell.Comment.Visible = True
                Set iCell = Me.UsedRange.FindNext(After:=iCell)
           Loop While Not iCell Is Nothing And iCell.Address <> iAddress$
        End If
    End Sub
    В этом варианте используется поиск частичного совпадения LookAt:=xlPart

    Вариант II.
    Private Sub SearchTextInComments2()
        iSearchText$ = "*" & "текст" & "*"

        Dim iCell As Range
        Set iCell = Me.UsedRange.Find _
        (What:=iSearchText$, LookIn:=xlComments, LookAt:=xlWhole)

        If Not iCell Is Nothing Then
           iAddress$ = iCell.Address
           Do
                iCell.Comment.Visible = True
                Set iCell = Me.UsedRange.FindNext(After:=iCell)
           Loop While Not iCell Is Nothing And iCell.Address <> iAddress$
        End If
    End Sub
    В этом варианте используется поиск полного совпадения LookAt:=xlWhole, однако, применение символа подстановки * позволяет добиться результата, при котором будет найдено примечание, содержащее, например : "Этот текст не должен содержать опечяток, но ..."

    Комментарий : Символы подстановки имеет смысл применять для поиска текста согласно заданному шаблону.
  • Ответ :

    Вариант I.
  • Private Sub DisplayTextInTheNextCell()
        On Error GoTo ErrHandler
        
        Dim iCell As Range
        For Each iCell In Selection.SpecialCells(xlComments)
            If iCell.Column < 256 Then
               iCell.Next.Value = iCell.Comment.Text
            Else
               MsgBox "Нельзя вывести текст в несуществующий 257 столбец", vbCritical, _
               "Ошибка вывода текста примечания из ячейки : " & iCell.Address
            End If
        Next
        Exit Sub
    
    ErrHandler:
        MsgBox Err.Description, vbExclamation, ""    
    End Sub
    Вариант II.
    Private Sub DisplayTextInTheNextCell2()
        Dim iCell As Range, iFirstAddress$
        Set iCell = Selection.Find(What:="*", LookIn:=xlComments)
    
        If Not iCell Is Nothing Then
           iFirstAddress = iCell.Address
           Do
                Set iCell = Selection.FindNext(After:=iCell)
                If iCell.Column < 256 Then
                   iCell.Next.Value = iCell.Comment.Text
                Else
                   MsgBox "Нельзя вывести текст в несуществующий 257 столбец", vbCritical, _
                   "Ошибка вывода текста примечания из ячейки : " & iCell.Address
                End If
           Loop While iCell.Address <> iFirstAddress
        End If
    End Sub
    Вариант III.

    Если выделенный диапазон относительно небольшой, то можно и просто "перебрать" все ячейки этого диапазона, т.е.
    Private Sub DisplayTextInTheNextCell3()
        Dim iSource As Range, iCell As Range, iColumn&, iText$, iMsg$
        Set iSource = Intersect(ActiveSheet.UsedRange, Selection)
        
        If iSource Is Nothing Then Exit Sub
        
        iColumn = Columns.Count
        iMsg = "Нельзя вывести текст в несуществующий " & iColumn + 1 & " столбец"
        
        For Each iCell In iSource
            iText = iCell.NoteText
            If iText <> "" Then
               If iCell.Column < iColumn Then
                  iCell(1, 2).Value = iCell.NoteText
               Else
                  MsgBox iMsg, vbCritical, _
                  "Ошибка вывода текста примечания из ячейки : " & iCell.Address
               End If
            End If
        Next
    End Sub
    Тоже самое, но без проверки.
    Private Sub DisplayTextInTheNextCell3v2()
        Dim iCell As Range, iText$
        For Each iCell In Selection
            iText = iCell.NoteText
            If iText <> "" Then iCell(1, 2) = iText
        Next
    End Sub
    Примечание :
  • - Если рабочий лист защищён, то первый макрос работать не будет, если Вы не будете использовать этот [FAQ42]
  • - Если выделить всего одну ячейку, то первый макрос "переберёт" все ячейки рабочего листа, содержащие комментарии/примечания (если таковые конечно имеются)
  • - Не забывайте проверять действительно ли выделена ячейка/диапазон ячеек [FAQ104]
  • - Для корректной работы обоих макросов нужно, чтобы фокус ввода находился в ячейках рабочего листа (это актуально только для MS Excel 97)

    Комментарий : Если в выделенном диапазон будет много ячеек с комментариями/примечаниями, то на время вывода текста в ячейки, имеет смысл отключить обновление экрана [FAQ43]
  • Ответ : Скачать пример

    Вариант I.
  • With Worksheets(1)
         For Each iComment In .Comments
             iRow = iRow + 1
             .Cells(iRow, 2) = iComment.Text
             .Cells(iRow, 3) = iComment.Parent.Address
         Next
    End With
    With Worksheets(1)
         For iCount = 1 To .Comments.Count
             .Cells(iCount, 2) = .Comments(iCount).Text
             .Cells(iCount, 3) = .Comments(iCount).Parent.Address
         Next
    End With
    Вариант II.
    On Error GoTo ErrHandler

    With Worksheets(1)
         For Each iCell In .UsedRange.SpecialCells(xlComments)
             iRow = iRow + 1
             .Cells(iRow, 2) = iCell.Comment.Text
             .Cells(iRow, 3) = iCell.Address
         Next
    End With

    Exit Sub

    ErrHandler:
         MsgBox Err.Description, vbExclamation, ""
    Вариант III.
    With Worksheets(1)

         Set iCell = .UsedRange.Find(What:="*", LookIn:=xlComments)

         If Not iCell Is Nothing Then

            iFirstAddress = iCell.Address

            Do
               Set iCell = .UsedRange.FindNext(After:=iCell)

               iRow = iRow + 1
               .Cells(iRow, 2) = iCell.Comment.Text
               .Cells(iRow, 3) = iCell.Address

               Loop While Not iCell Is Nothing And iCell.Address <> iFirstAddress

         End If

    End With
    Set iList = Worksheets(1)
    Set iCell = iList.UsedRange.Find(What:="*", LookIn:=xlComments)

    If Not iCell Is Nothing Then

       iFirstAddress = iCell.Address

       Do
            Set iCell = iList.UsedRange.FindNext(After:=iCell)
            iRow = iRow + 1
            iList.Cells(iRow, 2) = iCell.Comment.Text
            iList.Cells(iRow, 3) = iCell.Address
       Loop While Not iCell Is Nothing And iCell.Address <> iFirstAddress

    End If
    Внимание :
  • - Worksheets(1) и Столбцы "B" (2) и "C" (3) выбраны исключительно в качестве примеров

    Примечание :
  • - Если рабочий лист защищён, то второй макрос работать не будет, если Вы не будете использовать этот [FAQ42]
  • Ответ :

    Для того, чтобы создать "архив" примечаний активной рабочей книги, можно сохранить текст примечаний, а также адреса ячеек, которые их содержат, например, в текстовый файл. Для этого, достаточно воспользоваться макросом ExportComments, а чтобы восстановить сохранённые комментарии, можно использовать макрос ImportComments
  • Private Sub ExportComments() 'XL2000, XP, 2003
        Dim iFileName$, iList As Worksheet, iComment As Comment
        iFileName = Replace(ActiveWorkbook.FullName, ".xls", ".txt")
        
        Open iFileName For Output As #1
             For Each iList In ActiveWorkbook.Worksheets
                 For Each iComment In iList.Comments
                     Print #1, iComment.Parent.Address(, , , True)
                     Print #1, iComment.Text
                 Next
             Next
        Close #1
    End Sub
    
    Private Sub ImportComments() 'XL2000, XP, 2003
        Dim iFileName$, iAddress$, iText$
        iFileName = Replace(ActiveWorkbook.FullName, ".xls", ".txt")
        
        If Dir(iFileName) = "" Then
           MsgBox "Нет архива с комментариями", vbCritical, ""
           Exit Sub
        End If
        
        Open iFileName$ For Input As #1
             Do Until EOF(1)
                Line Input #1, iAddress
                Line Input #1, iText
                With Application.Range(iAddress)
                     If .Comment Is Nothing Then .AddComment iText
                End With
                'Application.Range(iAddress).NoteText iText
             Loop
        Close #1
    End Sub
    Примечание :
  • - Если в тексте комментариев будет встречаться символ возврата каретки Chr(13) (vbCr) или комбинация символов возврат каретки + перевод строки Chr(13) + Chr(10) (vbCrLf), то возникнет ошибка, т.к. эти символы являются признаком окончания строки для инструкции Line Input. Чтобы избежать такой ошибки, можно воспользоваться другим вариантом.
  • - Для импорта примечаний необходимо, чтобы рабочий лист не был защищён в отношении об'ектов, т.к. в противном случае возникнет ошибка 1004, которой, впрочем, можно избежать, если использовать данный совет.
  • - Для импорта примечаний также необходимо, чтобы рабочий лист, после экспорта не был переименован.
  • - В данном примере, примечание "восстанавливается" (по сути, просто создаётся заново) только в случае его отсутствия. Проще говоря, если текст комментария был, допустим, "Отгрузка 22/07/2006" и Вы создали архив примечаний, а затем, изменили текст на "Отмена". После чего, восстановили все примечания, то всё равно останется отмена. Впрочем, при желании, всё это можно изменить.
  • - Обладатели новых версий вместо расширения ".xls" могут указать своё, например, ".xlsm", ".xlsx" или определять расширение книги программно, т.е. с помощью VBA.
  • - Обладатели же XL97 вместо Replace должны использовать Application.Substitute или WorksheetFunction.Substitute
  • Ответ :

    Для того, чтобы скопировать формат нужного примечания нужно использовать метод PickUp, а для того, чтобы применить его, необходимо использовать метод Apply
  • ActiveSheet.Comments(1).Shape.PickUp

    ActiveSheet.Comments(5).Shape.Apply
    Предполагается, что :
    - в активном рабочем листе есть, как минимум, пять комментариев
    - скопировать необходимо формат первого
    - а вставить формат необходимо в пятый комментарий
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы сразу после активации ячейки, которая содержит примечание, отобразить это примечание на экране, достаточно скопировать весь нижеприведённый код и разместить его в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
         Application.DisplayCommentIndicator = xlNoIndicator 'xlCommentIndicatorOnly
         If Not ActiveCell.Comment Is Nothing _
            Then ActiveCell.Comment.Visible = True
    End Sub
    Если же нужно отобразить только те комментарии, которые обязательно содержит текст, то :
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
         Application.DisplayNoteIndicator = False
         If Len(Target(1, 1).NoteText) > 0 Then
            Target(1, 1).Comment.Shape.Visible = True
         End If
    End Sub

  • Ответ :

    Для того, чтобы программно скрыть, оставить только индикатор (небольшой красный треугольник, расположенный в верхнем правом углу ячейки) или отобразить все примечания(комментарии), достаточно воспользоваться свойством DisplayCommentIndicator об'екта Application
  • Application.DisplayCommentIndicator = xlNoIndicator

    Application.DisplayCommentIndicator = xlCommentIndicatorOnly

    Application.DisplayCommentIndicator = xlCommentAndIndicator
    Актуально для MS Excel 95
    В этой версии, как, впрочем, и в последующих, для скрытия примечаний и отображения только индикаторов, можно использовать и такой вариант :
    Application.DisplayNoteIndicator = False

    Application.DisplayNoteIndicator = True
    Комментарий : Если тоже самое необходимо проделать без применения VBA, то в меню Сервис выберите команду Параметры, и в появившемся стандартном диалоговом окне выделите закладку Вид и в разделе Примечания установите "флажок" напротив нужного вида.
  • Ответ :

    Для того, чтобы с помощью VBA изменить ширину и высоту всех примечаний(комментариев) определённого рабочего листа, можно использовать нижеопубликованный макрос, где размер увеличивается на 25%
  • Private Sub ResizeShapeComment()
        Dim iComment As Comment
        For Each iComment In Worksheets(1).Comments
            With iComment.Shape
                 .Width = .Width * 1.25
                 .Height = .Height * 1.25
            End With
        Next
    End Sub
    Внимание : Worksheets(1) - первый рабочий лист активной книги, выбран исключительно в качестве примера и может быть заменён на любой другой рабочий лист.
  • Ответ :

    Для того, чтобы суммировать данные только тех ячеек, что содержат нужное примечание(комментарий) можно воспользоваться нижеопубликованным вариантом. Обратите внимание на то, что в качестве критерия суммирования, используется текст примечания ячейки "A1" первого рабочего листа текущей рабочей книги. Это условие, конечно же, не является обязательным и Вы можете указать другую ячейку или даже выбрать её, например, с помощью диалогового окна.
  • Private Sub Sum_CriteriaNoteText()
        With ThisWorkbook.Worksheets(1)
             iText$ = .Range("A1").NoteText
             Dim iCell As Range
             Set iCell = .UsedRange.Find( _
             What:=iText$, LookIn:=xlComments, LookAt:=xlWhole)
             If Not iCell Is Nothing Then
                iAddress$ = iCell.Address
                Do
                   If IsNumeric(iCell) = True Then _
                      iResult& = iResult& + iCell.Value
                   Set iCell = .UsedRange.FindNext(After:=iCell)
                Loop While iCell.Address <> iAddress$
                MsgBox "Итого : " & iResult&, , ""
             End If
        End With
    End Sub
    Private Sub Sum_CriteriaCommentText()
        With ThisWorkbook.Worksheets(1)
             If .Range("A1").Comment Is Nothing Then
                MsgBox "Ячейка не содержит комментарий", , ""
                Exit Sub
             End If
             Dim iCell As Range
             Set iCell = .UsedRange.Find(What:=.Range("A1"). _
             Comment.Text, LookIn:=xlComments, LookAt:=xlWhole)
             iAddress$ = iCell.Address
             Do
                If IsNumeric(iCell) = True Then _
                   iResult& = iResult& + iCell.Value
                Set iCell = .UsedRange.FindNext(After:=iCell)
             Loop While iCell.Address <> iAddress$
             MsgBox "Итого : " & iResult&, , ""
        End With
    End Sub

  • Ответ :

    Для того, чтобы программно, с помощью Проверки орфографии, найти и при желании исправить слова, написанные с ошибками, в тексте нужного примечания, можно использовать метод CheckSpelling
  • ActiveSheet.Comments(1).Shape.DrawingObject.CheckSpelling AlwaysSuggest:=True
    ActiveSheet.Comments(1).Shape.OLEFormat.Object.CheckSpelling AlwaysSuggest:=True
    If ActiveSheet.Comments(1).Shape.DrawingObject.CheckSpelling(AlwaysSuggest:=True) = True Then
         MsgBox _
         "Текст примечания не содержит ошибок ... " & vbCrLf & _
         "или примечание не содержит текста", , "Проверка орфографии"
    End If

  • Ответ :

    Если Вы пользуетесь "умной" таблицей и хотите добавить побольше информации о ней, например, создать комментарий (содержащий не более 255 символов), то это можно осуществить с помощью свойства Comment об'екта ListObject
  • ActiveSheet.ListObjects(1).Comment = "Таблица продаж за 2012 год"
    Worksheets(1).ListObjects(1).Comment = "Таблица продаж за 2013 год"
    Worksheets("Лист1").ListObjects("Таблица1").Comment = "Таблица продаж за 2014 год"
    Если же возникнет необходимость в прочтении такого комментария, то :
    MsgBox ActiveSheet.ListObjects(1).Comment
    Внимание : Имена листов/таблиц и их индексы(номера) выбраны исключительно в качестве примера и могут(должны) быть заменены на те, что используются в Вашей рабочей книге.

    Комментарий : Несмотря на размещение данного FAQ в этом разделе, в реальности, этот комментарий не имеет никакого отношения к семейству Comments, просто этот раздел оказался наиболее близким по смыслу. Впрочем, если Вы считаете, что есть более подходящая страница, то можете оставить свой вариант, например, в гостевой книге.
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2017 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff