Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование или перенос комментария в ячейку
 
#1
17.01.2019 20:28:43
Здравстуйте знатоки!
Как скопировать или перенести комментарий из ячейки в столбце A в ячейку в столбце B с сохранением цветов?
Спасибо за помощь.
с уважением Альвидас
 
 
 
#2
17.01.2019 20:44:27
файл xlsb, я так понял, что нужен макрос:
Код
Sub CopyPaste()
    Cells(1, 1).Copy Cells(1, 4)
End Sub

или вручную.
Формулами невозможно.
 
 
 
#3
17.01.2019 20:45:18
копия, специальная вставка, комментарий.
По вопросам из тем форума, личку не читаю.
 
 
 
#4
17.01.2019 21:13:13
Михаил Витальевич С.,спасибо, но эта команда копирует полностью (и текст и комментарий). Нужно, чтобы в столбец B - скопировалась только инфо из комментария.
 
 
 
#5
17.01.2019 21:49:10
Kin-Dza-Dza, а способ из #3 не работает?
Ну или если нужно именно макросом, то так можно:
Код
Cells(2, 1).Copy
Cells(2, 2).PasteSpecial Paste:=xlPasteComments
 
 
 
#6
17.01.2019 22:35:54
_Igor_61,Copy-PasteSpecial-Comments - копируеться комментарий (на место коментария) Нужно чтобы комментарий из столбца A появился в столбце B не как комментарий - а как текст в ячейке. В столбце A - 100 000 строк.
 
 
 
#7
17.01.2019 22:38:08
Почитайте здесь.
 
 
 
#8
17.01.2019 22:42:39
Цитата
Kin-Dza-Dza написал:
Нужно чтобы комментарий из столбца A появился в столбце B не как комментарий - а как текст в ячейке
- это было не очивидно конечно, могли б в примере показать что есть и что надо, было б все проще.
По вопросам из тем форума, личку не читаю.
 
 
 
#9
17.01.2019 23:34:31
Юрий М,Похоже - то, что надо. Только данная функция не переносит цветов (в одном комментарии есть и несколько их - что имеет значение).
Был бы благодарен за коррекцию данной функции (чтобы переносились и цвета комментария)
Код
Function Get_Text_from_Comment(rCell As Range)
   On Error Resume Next
   Get_Text_from_Comment = rCell.Comment.Text
 End Function
Изменено: Kin-Dza-Dza - 17.01.2019 23:36:01
 
 
 
#10
17.01.2019 23:39:57
Kin-Dza-Dza, в простейшем случае так
Код
Sub CopyComments()
Dim c As Comment, t As TextFrame, r As Range, i&
  For Each c In ActiveSheet.Comments
    Set t = c.Shape.TextFrame
    Set r = c.Parent.Offset(, 1)
    r.Value = c.Text
    For i = 1 To Len(r.Value)
      r.Characters(i, 1).Font.Color = t.Characters(i, 1).Font.Color
    Next
  Next
End Sub
 
 
 
#11
18.01.2019 13:53:09
Казанский,Используя Вашу команду - exel виснет через несколько секунд. (На маленьком файле - работает).
А вот команда #9 - всё быстро делает - только цвета не передаёт. Может вышло бы тот код подправить?
 
 
 
#12
18.01.2019 13:59:16
Цитата
Kin-Dza-Dza написал:
только цвета не передаёт
честно говоря, я вообще не нашел, как сделать текст в комментарии цветным.
 
 
 
#13
18.01.2019 14:02:16
Миша, на главной - кнопка Формат - Формат примечания: там можно назначить цвет.
 
 
 
#14
18.01.2019 14:05:04
Цитата
Kin-Dza-Dza написал:
Может вышло бы тот код подправить?
не вышло бы, потому что функции листа не могут изменять форматы. А код Алексея тормозит именно из-за попытки форматировать на основании цвета текста в комментарии. Посимвольное форматирование текста дело не быстрое....
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#15
18.01.2019 14:07:13
Михаил Витальевич С.,создаёте комментарий, "Select" весь или часть его, правой частью мыши щелчок, "Format Comment", - и задаёте цвета, шрифты - как хочеться...
 
 
 
#16
18.01.2019 14:25:04
Kin-Dza-Dza, спасибо, понял.
Макрорекордер этого не пишет (у меня 2016).
Возможно, в 2003 и записал бы (там макрорекордер чуть более расширен), но у меня счас нет.
 
 
 
#17
18.01.2019 14:28:15
2013 пишет.
 
 
 
#18
18.01.2019 14:33:05
Юрий М, 2013 у меня тоже нет, да и пишет, наверно, примерно так:
Код
Sub Макрос3()
'
' Макрос3 Макрос
'

'
    Range("I3").Comment.Shape.Select True
    Range("I3").Comment.Text Text:="Михаил С.:" & Chr(10) & ""
    Range("J7").Select
End Sub

изменения цвета нет. :(
 
 
 
#19
18.01.2019 14:35:02
Код
Sub Макрос1()
    Range("C3").Select
    Range("C3").Comment.Text Text:="Юрий:" & Chr(10) & "Мой текст"
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "полужирный"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("D13").Select
End Sub
 
 
 
#20
18.01.2019 14:50:06
Юрий М, спасибо!
 
 
 
#21
18.01.2019 14:50:07
редактируйте примечания, выполните этот макрос:
Код
Sub CopyPaste()
  Dim cs(), i&
  With Cells(2, 1).Comment.Shape
    ReDim cs(1 To Len(.DrawingObject.Caption))
    For i = 1 To UBound(cs)
      Set cs(i) = .TextFrame.Characters(i, 1)
    Next
    Cells(2, 2) = .DrawingObject.Caption
  End With
  For i = 1 To UBound(cs)
    With Cells(2, 2).Characters(i, 1).Font
      .Bold = cs(i).Font.Bold: .Color = cs(i).Font.Color: .Italic = cs(i).Font.Italic
      .Name = cs(i).Font.Name: .Size = cs(i).Font.Size: .Subscript = cs(i).Font.Subscript
      .Superscript = cs(i).Font.Superscript: .Underline = cs(i).Font.Underline
    End With
  Next
End Sub
Изменено: Ігор Гончаренко - 18.01.2019 15:00:05
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#22
02.02.2019 20:18:45
Цитата
Kin-Dza-Dza написал:
Используя Вашу команду - exel виснет через несколько секунд
Попробуйте оптимизированную версию макроса - она меняет цвет не каждого символа, а группы символов с одинаковым цветом. Заодно обрезает перевод(ы) строки в конце текста.
Код
Sub CopyComments()
Dim c As Comment, t As TextFrame, r As Range, i&, j&, coli&, colj&, s$
  Application.ScreenUpdating = False
  For Each c In ActiveSheet.Comments
    Set t = c.Shape.TextFrame
    s = c.Text
    For i = Len(s) To 1 Step -1
      If Mid$(s, i, 1) <> vbLf Then Exit For
    Next
    If i Then
      Set r = c.Parent.Offset(, 1)
      r.Value = Left(s, i)
      j = 1: colj = t.Characters(j, 1).Font.Color
      For i = 2 To i
        coli = t.Characters(i, 1).Font.Color
        If coli <> colj And Mid$(s, i, 1) <> " " Then
          r.Characters(j, i - j).Font.Color = colj
          j = i: colj = coli
        End If
      Next
      r.Characters(j, i - j).Font.Color = colj
    End If
  Next
  Application.ScreenUpdating = True
End Sub
 
 
 
Страницы: 1
Наверх