Bonsoir ,
Je voudrais complèter ce code pour supprimer les commentaires des cellules s'ils sont vides.
Et serait il possible de mettre la taille de la police des commentaires en 14 et gras ?
Merci pour votre aide
Je voudrais complèter ce code pour supprimer les commentaires des cellules s'ils sont vides.
Et serait il possible de mettre la taille de la police des commentaires en 14 et gras ?
Code:
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
comm = ""
Next
End Sub
Merci pour votre aide