mettre un commentaire déjà prêt dans plusieurs cellules

[natorp]

Bjr à tous et toutes

J'ai trouvé ça sur le fil :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Range("B3")
If .Comment Is Nothing Then

.AddComment
.Comment.Text Text:="Libre à " & Range("ak3").Value
.Comment.Shape.TextFrame.AutoSize = True
End If
End With

End Sub

mon soucis maintenant c'est de mettre ce commentaire sur toutes les cellules de la plage b3:af18
qui reprennent le contenu de la plage : ak3:bo18

merci de votre aide, Gérard

 

[PMO2]

Re : mettre un commentaire déjà prêt dans plusieurs cellules

Bonjour,

Essayez avec votre code modifié ci-dessous

'### Plages à adapter (celles-ci doivent être de même grandeur ###
'### et leur ligne de départ se situer sur la même ligne)      ###
Const SOURCE As String = "ak3:bo18"
Const CIBLE As String = "b3:af18"
'#################################################################

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim R As Range
Dim C As Range
Dim IncrCol&
Set R = Application.Intersect(Application.Union(Range(SOURCE), _
                              Range(CIBLE)), Target)
If R Is Nothing Then Exit Sub
IncrCol& = Range(SOURCE).Column - Range(CIBLE).Column
Set R = Application.Intersect(Target, Range(CIBLE))
If Not R Is Nothing Then
  For Each C In Range(CIBLE)
    If Not C.Comment Is Nothing Then C.Comment.Delete
  Next C
  With Target
    .AddComment
    With .Comment
      .Visible = False
      .Text Text:="Libre à " & Target.Offset(0, IncrCol&)
      .Shape.TextFrame.AutoSize = True
    End With
  End With
End If
End Sub

Cordialement.

PMO
Patrick Morange