Excel 2007, как проверить что комментарий существует?

[^D^ima]

На 1С через COM взаимодействую с Excel 2007.
Так создаю комментарий к ячейке: Cells(х, у).AddComment();
Так получаю текст: текст = Cells(х, у).Comment.text();
Так передаю: Cells(х, у).Comment.text(Текст);

А как проверить что у ячейки нет комментария и его нужно создавать?

Этот код вылетит с ошибкой : текст = Cells(х, у).Comment.text();, т.к. комментария нет, нет и текста.

[VisualProg]

Цитата ^D^ima @ 24.05.18, 13:23

Этот код вылетит с ошибкой : текст = Cells(х, у).Comment.text();, т.к. комментария нет, нет и текста.

Вы же сами ответили на свой вопрос... или я не так его понял?

Если при чтении вылетает ошибка - это то от чего можно отталкиваться, делайте On Error GoTo ErrHandler и по метке ErrHandler ловите отсутствующий комментарий.

VB я практически забыл, но, суть примерно такая:

Function IsExistComment(x As Integer, y As Integer) As Bool
    On Error GoTo ErrHandler
        dim text as String
        text = Cells(х, у).Comment.text()
        IsExistComment = true
        Exit Function
    ErrHandler:
        IsExistComment = false
End Function

Сообщение отредактировано: VisualProg - 24.05.18, 14:06

[^D^ima]

Возможно как-то можно кроме обработки исключения сделать проверку?

[Akina]

Коллекция комментариев - увы, убогенькая... так что, в зависимости от того, что реально нужно, ловите и обрабатывайте либо ошибку чтения несуществующего комментария, либо ошибку создания уже существующего.

[^D^ima]

Akina, ясно, спасибо.

[MIF]

А у меня получилось без генерации ошибки.

Option Explicit
 
Private Sub Test()
 
Dim rng As Range
Set rng = Cells(2, 2)
 
If CommentsExist(Sheet1, rng) Then
    MsgBox "The range has a comment."
Else
    MsgBox "The range does not have a comment."
End If
 
End Sub
 
Private Function CommentsExist(sht As Worksheet, pRng As Range) As Boolean
 
Dim cs As Comments
Dim c As Comment
Dim I As Long
Dim rng As Range
 
Set cs = sht.Comments
 
For I = 1 To cs.Count
    Set c = cs(I)
    Set rng = c.Parent
    If rng.row = pRng.row And rng.column = pRng.column Then
        CommentsExist = True
        Exit For
    End If
Next I
 
End Function

В коде сравнения есть баг "Некорректный результат для комментария на несколько ячеек. Но ето ты сам выпиливай.

Добавлено 25.05.18, 07:29
Зы: писал в Excel 2019. Надеюсь, что в 2007 он работает.

[Akina]

Цитата MIF @ 25.05.18, 07:28

писал в Excel 2019

Гость из будущего?

Цитата MIF @ 25.05.18, 07:28

В коде сравнения есть баг "Некорректный результат для комментария на несколько ячеек.

Это в каком случае? к диапазону более чем из одной ячейки коммент не прикрутишь, а для поиска в диапазоне выполняется проверка для левоверхней ячейки, что в общем логично - если надо найти все, во внешнем поиске надо в явном виде вертеть ForEach.

[MIF]

Цитата Akina @ 25.05.18, 09:06

к диапазону более чем из одной ячейки коммент не прикрутишь,

В 2019 - прикручивается.

[Akina]

Цитата MIF @ 25.05.18, 13:09

В 2019 - прикручивается.

Ну тогда, в зависимости от того, что требуется, либо ForEach по обоим Range, либо тестить Range(Split(incomeRange.Address, ":")(0)).

[pashulka]

^D^ima, Проверить наличие комментария можно так :

If Not Cells(х, у).Comment Is Nothing Then
   MsgBox "Есть примечание"
Else
   MsgBox "Примечание изволит отсутствовать"
End If

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

Cells(х, у).ClearComments
Cells(х, у).AddComment

А если от комментария Вам нужен только текст, то :

Cells(x, y).NoteText "Новый текст комментария"

[^D^ima]

pashulka
Попробую, спасибо. Удалять нельзя, т.к. нужно добавлять к существующему комментарию текст и стало быть если нет комментария, добавить

[Akina]

Цитата ^D^ima @ 04.06.18, 05:37

Удалять нельзя, т.к. нужно добавлять к существующему комментарию текст и стало быть если нет комментария, добавить

Ну тогда можно вывернуться по типу

NewText = IIf(Cells(x, y).Comment Is Nothing, "", Cells(x, y).Comment.Text & vbNewLine) & "Дополнение к комментарию"
Cells(х, у).ClearComments
Cells(х, у).AddComment NewText

[pashulka]

^D^ima, Если удалять нельзя, то можно и так :

With Cells(x, y)
     If .Comment Is Nothing Then
        .AddComment "Новый текст1"
     Else
        .Comment.Text .Comment.Text & vbCrLf & "Новый текст2"
     End If
End With

With Cells(x, y)
     If .Comment Is Nothing Then
        .AddComment "Новый текст2"
     Else
        .Comment.Text vbCrLf & "Новый текст4", Len(.Comment.Text) + 1
     End If
End With

И рекомендую присмотреться к методу NoteText , который не требует проверки существования примечания. Правда там, для создания текста примечания, содержащего более 255 символов, придётся использовать цикл.