разные цвета шрифта "комментария"

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
_невиДимка_
Сообщения: 2
Зарегистрирован: 16 июн 2009, 14:21

Здравствуйте.
к сожалению, запись макроса не записывает действия по изменению размеров и цвета комментария. Примерный текст макроса:
iList = 1
While wList.Cells(iList, 5) <> Empty
Name = wList.Cells(iList, 1)
City = wList.Cells(iList, 2)
X = Val(wList.Cells(iList, 3))
Y = Val(wList.Cells(iList, 4))
Set Cell = wMap.Cells(Y + 1, X + 1)

On Error Resume Next
Cell.AddComment
Cell.Comment.Text Cell.Comment.Text & Name & " - " & City & Chr(10)
Cell.Comment.Visible = False

iList = iList + 1
Wend

Подскажите, пожалуйста, как добавлять комментарий определенного цвета, т.е. первую строку красного цвета, другую возможно синего или зеленого и т.д. и как установить размер шрифта.
Заранее спасибо.
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

Код: Выделить всё

Sub [B]test_comment[/B]()
    Dim celll As Range, str As String: Set celll = Range("a1"): str = ""
    celll.ClearComments
    For i = 1 To 10: str = str & "Строка № " & i & vbLf: Next i
    celll.AddComment str
    
    With celll.Comment.Shape
        .Width = 200: .Height = 250
        .AutoShapeType = 16
        .Fill.ForeColor.SchemeColor = 11
        .Fill.TwoColorGradient msoGradientFromCenter, 2
    End With
    With celll.Comment.Shape.TextFrame
        For i = 1 To .Characters.Count
            letter = .Characters(Start:=i, Length:=1).Text
            .Characters(Start:=i, Length:=1).Font.Bold = IsNumeric(letter)
            .Characters(Start:=i, Length:=1).Font.Color = IIf(IsNumeric(letter), vbBlack, vbRed)
            If letter = "№" Then .Characters(Start:=i, Length:=1).Font.Size = 16
        Next
    End With
    celll.Comment.Visible = True
End Sub
Подробнее можно почитать здесь: http://msoffice.nm.ru/faq/macros/comments.htm

Пример во вложении:
Вложения
Комментарии.zip
(10.05 КБ) 15 скачиваний
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
_невиДимка_
Сообщения: 2
Зарегистрирован: 16 июн 2009, 14:21

EducatedFool
спасибо большое, буду разбираться :)
а по ссылке этой я все посмотрел, такого навороченного не нашел...
Ответить