Как поправить код: Копировать/Вставить Примечание с одной ячейки в другую [VBA].

[rediffusion]

Здравья желаю!
Нашёл вот такой код (он работает). Дело в том что он копирует текст 'Примечания' и вставляет в ячейку а не в само 'Примечание' (диапазон можно выбрать из всплывающей формы), 'Примечания' из ячейки удаляет (не хочу чтоб адаляло) ↴

Sub TestCommentCopy()

Dim r As Range
Dim c As Comment
Set r = Selection

If (Not r.Areas(1).Comment Is Nothing) Then
    Set c = r.Areas(1).Comment
End If

'Set r(1, 2).Comment = c ' Object error
'   r(1, 2).Comment = c  'Object error
'   Set r(1,2).Comment = c ' Object error
r(1, 2).ClearComments ' Works
'   r(1, 2).AddComment c 'Does not work - requires text only

r(1, 2).AddComment c.Text 'Works, but only get plain text, no formatting

End Sub

Есть ли способ в Excel скопировать 'Примечания' одной ячейки и вставить в другую (чтоб диапазон можно было выбрать в форме всплывающей).
1. Чтоб 'Примечания' не удалялось после копирования.
2. Чтоб была проверка имеется ли в копируемой ячейке 'Примечание', чтоб старое удалилось.
3. Чтоб можно было вставить не только в одну ячейку а в столько сколько нужно (выбираем диапазон в форме и вставляем, чтоб не мучиться и не вставлять по одной целый день).
4. Выполнение должно быть в активном листе.
5. Если в ячейке есть записи они не должны затираться.

dbcabb7233.jpg

Нашёл 3 `VBA` кода осталось понять как всё это дело комбинировать!?

1. Этот вариант хороший:

Sub copyComment_1()
    Range("A1").Copy
    Range("A2").PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

2. Аналогичная технология + выбор Листа:

Sub copyComment_2()

    Dim sht As Worksheet
    Dim destRng As Range
    Dim srcRng As Range
    Set sht = ThisWorkbook.Worksheets("Лист2")
    Set srcRng = sht.Range("A1")
    Set destRng = sht.Range("A2")
    srcRng.Copy
    destRng.PasteSpecial xlPasteComments

End Sub

3. Аналогичная технология + выбор Листа (2 метода из них только второй работает как надо):

Sub copyComment_3()
    Dim strCom As String
    With ThisWorkbook.Worksheets("Лист2")
        'Метод 1
        'Получаем "Примечание" из ячейки A1
        strCom = .Range("A1").Comment.Text
        'Вставляем в ячейку A2 (если в ячейке уже имеется "Примечание" вылетает – ошибка)
        .Range("A2").AddComment strCom
        'Метод 2
        'Копировать/Вставить "Примечание" (этот вариант работате как надо)
        .Range("A1").Copy
        .Range("A2").PasteSpecial xlPasteComments
    End With
End Sub

Помохайте если можете!

[rediffusion]

!! Я нашёл соответствующую надстройку называется Ablebits. В ней имеется `Comments Manager` это реально удобная штука, гляньте! Мануал тут.

[Serge_Bliznykov]

Сообщение от rediffusion

Я нашёл соответствующую надстройку называется Ablebits.

и всего 79 долларов?

[pme]

Привет!

Сообщение от rediffusion

Sub copyComment_1()

Public Function Comment_Copy(ByVal r_Sour As Range, r_Dest As Range)

' пример Вызова Comment_Copy cells(1,1), cells(1,2)

    r_Sour.Copy

    r_Dest.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

End Function

[Aleksandr H.]

Sub gomfckr()
    Dim cl As Range
    With [E11] ' comment to past
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Visible = True
        End If
        Set cl = [b8] ' comment copy from
        If Not cl.Comment Is Nothing Then
            .Comment.Text Text:= _
                cl.Comment.Text
        Else
            .Comment.Text Text:="EMPTY TEXT"
        End If
            
    End With
End Sub

[rediffusion]

Сообщение от Serge_Bliznykov

и всего 79 долларов?

Тут можно скачать бесплатно!