Supprimer les commentaires qui contiennent rien

Sub Commentaire()


Dim comm As String

ActiveSheet.Unprotect
Cells.ClearComments ' efface les commentaires

Set plage = Range("B6:B26")
Set plage = Application.Union(plage, Range("G6:G30"))
Set plage = Application.Union(plage, Range("L6:L41"))
Set plage = Application.Union(plage, Range("Q6:Q39"))

tablo = Sheets("HEURE").Range("B2:W" & Sheets("HEURE").Range("B200").End(xlUp).Row)

For Each cel In plage
If InStr(cel.Value, Chr(10)) <> 0 Then
acomp = Split(cel.Value, Chr(10))(0)
Else
acomp = cel.Value
End If
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 1) = acomp Then
comm = comm & "Sort: " & Format(tablo(n, 3), "hh:mm") & " " & "Rentre: " & Format(tablo(n, 5), "hh:mm") & Chr(10)
lafin = tablo(n, 22) 'Texte en colonne 22 W à mettre en bas du commentaire
End If
Next
cel.ClearComments
cel.AddComment comm & Chr(10) & lafin 'Place le texte de la colonne G dans le commentaire

If Len(comm) > 30 Then
cel.Comment.Shape.Height = cel.Comment.Shape.Height * 1.5 ' Espace verticale
Else
cel.Comment.Shape.Height = cel.Comment.Shape.Height * 1.2
End If

If Len(comm) > 20 Then
cel.Comment.Shape.Width = cel.Comment.Shape.Width * 1.5 ' Largeur
End If
If comm = "" Then cel.ClearComments ' efface les commentaires vides

comm = ""



Next
For Each C In ActiveSheet.Comments
With C
.Shape.TextFrame.Characters.Font.Size = 12
.Shape.TextFrame.Characters.Font.Bold = True
End With
Next

End Sub

Cliquez pour agrandir...