Как вывести примечание в ячейку?

[pax]

Доброго времени суток, люди.
Подскажите пожалуйста, можно ли вывести причемачние к ячейке в саму ячейку?

Задача такова:
есть тысяча строчек и один столбец. К каждой ячейке есть примечание, нужно сделать так что бы это примечание было в самой ячейке.

Спасибо!

[Pavel55]

У меня есть 2 макроса. Один копирует значение ячейки в комментарий, а другой комментарий переносит в ячейку. Посмотрите, может они вам помогут. Данные макросы обрабатывают числа, но если вам надо переносить текст в комментарий и обратно, то я думаю, вы сами можете убрать проверку IsNumeric в этих макросах.

Sub Добавить_комментарий_в_диапазоне()
'копирует значение ячейки в комментарий в видемом диапазоне
    Dim c As Range, cc As Range
    Dim i As Long
    On Error GoTo ErrorHandler
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Set cc = Selection
    'если выделили 1 ячейку
    If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then
        MsgBox "Выделено слишком мало ячеек!", , "Ошибка"
        End
    End If
    Set cc = Selection.SpecialCells(xlCellTypeVisible)
    For Each c In cc
        If IsNumeric(c.Value) And c.Value <> Empty Then
            c.AddComment CStr(c.Value)
            i = i + 1
        End If
    Next
    MsgBox "Добавлено " & i & " комментарий!"
    Exit Sub
ErrorHandler:
    If err.Number = 1004 Then
        MsgBox "Удалите предыдущие комментарии и повторите заново!", , "Ошибка"
        Exit Sub
    End If
    MsgBox "Произошла ошибка!!!"
End Sub

Sub Комментарий_в_ячейку_в_диапазоне()
'переносит комментарий в ячейку
Dim i As Long
Dim c As Range, cc As Range
Dim iCommment As Comments
    On Error GoTo ErrorHandler
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set cc = Selection
    'если выделили 1 ячейку
    If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then
        MsgBox "Выделено слишком мало ячеек!", , "Ошибка"
        Exit Sub
    End If
    Set cc = Selection.SpecialCells(xlCellTypeVisible)
    For Each c In cc
        If c.Comment Is Nothing Then GoTo lbl
        If IsNumeric(c.Comment.Text) Then
            c.Value = CInt(c.Comment.Text)
           ' c.ClearComments
            i = i + 1
        End If
lbl:
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Перенесено " & i & " комментариев!"
    Exit Sub
ErrorHandler:
    MsgBox "Произошла ошибка!!!"
End Sub

[pax]

спасибо за отзывчивость!

Но есть одно но.. Не хочет переводить комментарии в ячейки.

Как вы и сказали, удалил проверку что это номер, код в таком виде:

Sub Комментарий_в_ячейку_в_диапазоне()
'переносит комментарий в ячейку
Dim i As Long
Dim c As Range, cc As Range
Dim iCommment As Comments
    On Error GoTo ErrorHandler
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set cc = Selection
    'если выделили 1 ячейку
    If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then
        MsgBox "Выделено слишком мало ячеек!", , "Ошибка"
        Exit Sub
    End If
    Set cc = Selection.SpecialCells(xlCellTypeVisible)
    For Each c In cc
        If c.Comment Is Nothing Then GoTo lbl
lbl:
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Перенесено " & i & " комментариев!"
    Exit Sub
ErrorHandler:
    MsgBox "Произошла ошибка!!!"
End Sub

Выделяю ячейки, но пишет Перенесено 0 комментариев.

[Pavel55]

А вы выделите диапазон ячеек и запустите макрос в редакторе VBE пошагово (через F8) и нажимайте F8 пока не увидите, где макрос делает что-то не то. А ещё можно выложить небольшой кусок вашей таблицы сюда (в архиве)

[pax]

вот пример файла.. пишет тоже самое..

[Pavel55]

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

Sub Комментарий_в_ячейку_в_диапазоне()
'переносит комментарий в ячейку
Dim c As Range, cc As Range
Dim i As Long
    On Error GoTo ErrorHandler
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set cc = Selection
    'если выделили 1 ячейку
    If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then
        MsgBox "Выделено слишком мало ячеек!", , "Ошибка"
        Exit Sub
    End If
    Set cc = Selection.SpecialCells(xlCellTypeVisible)
    For Each c In cc
        If c.Comment Is Nothing Then GoTo lbl
        c = c.Comment.Text
        i = i + 1
lbl:
    Next
    cc.WrapText = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Перенесено " & i & " комментариев!", vbInformation, "Комментарии"
    Exit Sub
ErrorHandler:
    MsgBox "Произошла ошибка!!!"
End Sub

[pax]

вот спасибо! выручили=)