VBA Tools

Przypuśćmy że arkusz edytuje wiele osób. Chcielibyśmy szybko rozróżnić komentarze, które są nadawane przez rożne osoby.

Można wykonać listę osób i przypisać im stosowne numery kolorów. Następnie kod taki można wywołać w procedurze zdarzeniowej Workbook_Open() aby stale realizować nadawanie kolorów.

Option Explicit

Sub Kolor_komentarza()
'MVP OShon from VBATools.pl
 Dim kom As Range, cmt As Comment
 For Each kom In ThisWorkbook.Worksheets(ActiveSheet.Name). _
 Range(Cells(1, 1), Cells.SpecialCells(xlLastCell).Address)
 Set cmt = kom.Comment
 On Error Resume Next
 If InStr(1, cmt.Text, ":") > 0 Then
 With cmt.Shape.TextFrame.Characters(1, Len(cmt.Text))
 Select Case Split(cmt.Text, ":")(0)
 Case Is = "Monika":     .Font.ColorIndex = 3
 Case Is = "Oskar":      .Font.ColorIndex = 5
 Case Else:              .Font.ColorIndex = 1
 End Select
 End With
 End If
 Set cmt = Nothing
 Next kom
End Sub

Przy rozszerzeniu jego funkcjonalności można zamiast nadawać określone wartości kolorów, utworzyć tablicę unikatów osób edytujących arkusz i nadać im przypadkowe kolory.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.