vba word добавить комментарий и автора - PullRequest
Новая
       31

vba word добавить комментарий и автора

2 голосов
/ 08 февраля 2011

У меня есть пользовательская форма в Word 2007, которая ищет определенные термины в документе и добавляет комментарии.У меня есть три разные категории для этих комментариев.Я хочу, чтобы комментарии были выделены цветом для каждой категории.На данный момент у меня есть решение, которое работает, но оно очень медленное.Есть ли другой способ назначить автора комментария непосредственно при создании комментариев?

Код для создания комментария: 

For i = 0 To UBound(CritArray)
    PosCount = 1
    With Selection
    .HomeKey wdStory
        With .Find
        .ClearFormatting
            Do While .Execute(FindText:=CritArray(i), _
            Forward:=True, _
            MatchWholeWord:=True)
Select Case i
...
End Select
            PosCount = PosCount + 1

            Selection.Comments.Add _
            Range:=Selection.Range, _
            Text:=MessArray(i) & CritArray(i) & "' - found for the" & Str(FoundCount) & ". time"

            Loop

        End With
    End With
Next

Код для назначения другого автора каждому комментарию - это приводит к другому цветузакодированные комментарии в разделе «Просмотр»> «Отслеживать изменения»> «Отслеживать изменения»> «Комментарии автора» выбраны: 

Dim CurrentExpField As String

For Each objCom In ActiveDocument.Comments

    CurrentExpField = Left$(objCom.Range.Text, 3)
    objCom.Author = UCase(CurrentExpField)
    objCom.Initial = UCase(CurrentExpField)

Next

1 Ответ

2 голосов
/ 18 марта 2011

Да, можно задать дополнительные свойства для Comment после его создания, поскольку метод Add для комментариев возвращает ссылку на новый объект Comment. Это означает, что вы можете выполнить цветовое кодирование за один проход. Я немного изменил ваш код, чтобы сделать это следующим образом: 

Dim cmtMyComment as Comment

For i = 0 To UBound(CritArray)
    PosCount = 1
    With Selection
    .HomeKey wdStory
        With .Find
        .ClearFormatting
            Do While .Execute(FindText:=CritArray(i), _
            Forward:=True, _
            MatchWholeWord:=True)
Select Case i
...
End Select
            PosCount = PosCount + 1

            Set cmtMyComment = Selection.Comments.Add(Range:=Selection.Range, _
            Text:=MessArray(i) & CritArray(i) & "' - found for the" & Str(FoundCount) & ". time")

            cmtMyComment.Author = UCase(Left$(cmtMyComment.Range.Text, 3))
            cmtMyComment.Initial = UCase(Left$(cmtMyComment.Range.Text, 3))

            Loop

        End With
    End With
Next
...