Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuitComment As String, AncienComment As String, NouvComment As String
Dim Pos As Integer, Tour As Integer, Deb As Integer, Part As Integer
Dim i As Integer
Dim TabComment As Variant
Tour = 3 'pour démarrer en ColorIndex en Rouge (ni noir ni blanc)
If Target.Address <> '$G$6' Then Exit Sub
SuitComment = Range('G6').Value
If SuitComment = '' Then Exit Sub
On Error Resume Next 'si il n'y a pas de Commentaire
AncienComment = Range('F15').Comment.Text
On Error GoTo 0
If AncienComment <> '' Then AncienComment = AncienComment & Chr(10)
NouvComment = AncienComment & SuitComment & Chr(160)
With Range('F15')
On Error Resume Next 'si il y a déjà un Commentaire
.AddComment
On Error GoTo 0
With .Comment
.Text Text:=NouvComment
.Visible = True
.Shape.OLEFormat.Object.Font.Bold = True
.Shape.TextFrame.AutoSize = True
.Shape.Fill.ForeColor.RGB = RGB(217, 217, 235)
End With
End With
TabComment = Split(NouvComment, Chr(160))
For i = 0 To UBound(TabComment) - 1
Pos = Pos + Part
Part = Len(TabComment(i)) + 1
Range('F15').Comment.Shape.TextFrame.Characters(Pos + 1, Part).Font.ColorIndex = Tour
Tour = Tour + 1
Next
End Sub
Function SplitZon97(ByVal Ch$, Sep$)
Dim Pos&, PosS&, T(), I&
Pos = 1
Do
PosS = InStr(Pos, Ch, Sep)
ReDim Preserve T(I)
On Error Resume Next
T(I) = Mid(Ch, Pos, PosS - Pos)
If Err <> 0 Then
Pos = Pos - 1
T(I) = Right(Ch, Len(Ch) - Pos)
Exit Do
End If
Pos = PosS + 1
I = I + 1
Loop While PosS > 0
SplitZon97 = T
End Function