'=============================================================================

'извлечение теста коментария

'

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Текст_коментария()

Dim rCell As Range

Dim iNbCln As Long

Dim iNbRowStart As Long: iNbRowStart = 30

Dim strComment As String

Dim m As Variant, mm As Variant

If Selection.Count > 1 Then Exit Sub

Set rCell = ActiveCell

iNbCln = rCell.Column

With rCell

If Len(.Comment.Text) > 0 Then

.Comment.Visible = False

strComment = .Comment.Text

If Len(strComment) > 0 Then

m = Split(strComment, Chr(10), -1, vbTextCompare)

For i = LBound(m) To UBound(m)

If Len(m(i)) > 0 Then

mm = Split(m(i), " : ", -1, vbTextCompare)

Cells(iNbRowStart + i, 1).Value = Trim(mm(LBound(mm)))

Cells(iNbRowStart + i, iNbCln).Value = Trim(mm(UBound(mm)))

End If

Next i

End If

End If

End With

End Sub

'=============================================================================