Innserer valeurs dans un commentaire

Bonjour,

Puis-je me permettre de vous poser une autre concernant la mise en forme des commentaires et rajouter un paramètre à mon code ?

Je m'explique :

Voici mon code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Range

Dim Com As Comment

Dim Chaine As String

Dim Val1 As Integer

Dim Val2 As Integer

Val1 = 8: Val2 = 0

If Target.Row < 56 Then Exit Sub 'seulement à partir de la ligne 56

If Target.Count > 1 Then Exit Sub 'seulement une seule cellule

If Target.Row Mod 9 <> Val1 And Target.Row Mod 9 <> Val2 Then Exit Sub

If Target.Column > 390 Then Exit Sub 'seulement jusqu'à la colonne 390

If Target.Row Mod 9 = Val1 Then Set Cel = Target.Offset(-6) Else Set Cel = Target.Offset(-7)

With Cel

Set Com = .Comment

If Not Com Is Nothing Then Com.Delete

If Target.Row Mod 9 = Val1 Then

If Target.Value <> "" Then Chaine = Target.Value

If Target.Offset(1).Value <> "" Then Chaine = Chaine & IIf(Target.Value <> "-", vbCrLf & Target.Offset(1).Value, Target.Offset(1).Value)

Else 'sinon, pour Val2

If Target.Value <> "" Then Chaine = Target.Value

If Target.Offset(-1).Value <> "" Then Chaine = Target.Offset(-1).Value & IIf(Target.Value <> "", vbCrLf & Chaine, "")

End If

If Chaine <> "" Then

Set Com = .AddComment

Com.Text Chaine

Com.Shape.TextFrame.AutoSize = True

Com.Visible = True '<--- le commentaire reste toujours affiché

End If

End With

End Sub

Ce code me permet de mettre dans un commentaire les valeurs des cellules "Activité midi" et "activité soir"

J'essaie de modifier ce code pour insérer un "-" entre les 2 valeurs mais je n'y arrive pas et si possible que la valeur de "Activité midi" soit en minuscule et la valeur de "Activité soir" soit en majuscule :

• Si les 2 valeurs sont renseignés, je voudrais donc que soit affiché dans le commentaire "valeur Activité midi" - "valeur activité soir" => ex : c-C
• Si seulement la valeur de "Activité midi" est renseigné alors soit affiché "valeur Activité midi" - => ex : c-
• Si seulement la valeur de "Activité soir" est renseigné alors affiché - "valeur activité soir" => ex : - C

De plus je voudrais qu'à la fin du commentaire soit affiché "*" si 1 commentaire existe dans la seconde ligne du résident (par exemple la ligne 57 pour SARICA, la ligne 66 pour DANEL, la ligne 75 pour ARRAMBIDE etc.

Je vous remercie de votre aide précieuse

Cordialement

Salut sylvainpyc,

quelque chose comme ça ?

Pas trop compris l'utilité de "*" et pas sûr de l'avoir utilisé à bon escient...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim sData$, iRow%, iIdx8%, iIdx0%
'
iRow = Target.Row
If Target.Count > 1 Or iRow < 56 Or Target.Column > 390 Then Exit Sub
If iRow Mod 9 <> 8 And iRow Mod 9 <> 0 Then Exit Sub
'
Application.EnableEvents = False
'
With IIf(iRow Mod 9 = 8, Target.Offset(-6), Target.Offset(-7))
    .ClearComments
    iIdx8 = IIf(iRow Mod 9 = 8, 0, -1)
    iIdx0 = IIf(iRow Mod 9 = 8, 1, 0)
    If Target.Offset(iIdx8) <> "" Then sData = LCase(Target.Offset(iIdx8))
    If Target.Offset(iIdx8) <> "" Or Target.Offset(iIdx0) <> "" Then sData = sData & "-"
    If Target.Offset(iIdx0) <> "" Then sData = sData & UCase(Target.Offset(iIdx0)) & " *"
    If sData <> "" Then
        .AddComment
        .Comment.Text sData
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = True
    End If
End With
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour,

Merci, votre code fonctionne trés bien.

Sauf pour l' "*"

Concernant "*", je voudrais que soit affiché une "*" quand par exemple pour le résident DANEL il y a un commentaire dans la ligne 67 (par ex dans le fichier ci-joint dans la cellule AW67.

J'ai un code ci-dessous qui me permet au clic droit de masquer ou afficher certaines lignes concernant chaque résident.

A l'impression, seules 2 lignes par résident sont affichées et par exemple pour le résident DANEL la ligne 67 sera masquée et l' "*" permettrait aux accompagnateurs de savoir qu'un commentaire caché donne l'explication de la modification de sa présence/absence.

Private Sub Worksheet_BeforeRightClick(ByVal R As Range, Cancel As Boolean)
  If Intersect(R, [B56:B191]) Is Nothing Or (R.Row - 2) Mod 9 Then Exit Sub
  Dim P As Range
  Cancel = True
  Set P = R(3, 1).Resize(7)
  P.EntireRow.Hidden = Not P.EntireRow.Hidden
  If P.EntireRow.Hidden = True Then Exit Sub
  R(4, 1).Resize(3).EntireRow.Hidden = True 'pour cacher
  R(9, 1).EntireRow.Hidden = True
End Sub

J'ai également un autre code qui me permet de repositionner les commentaires si je masque ou affiche des lignes ou des colonnes ce qui modifie l'emplacement des commentaires,j'appele ce code avec la zone de texte "replacer commentaires" en B55

Sub ResetComments()
Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
   cmt.Shape.Top = cmt.Parent.Top + 5
   cmt.Shape.Left = _
      cmt.Parent.Offset(0, 1).Left + 5
Next
End Sub

Serait-il possible aussi svp en cliquant sur la zone de texte en B55 "mis à jour commentaires" d'utiliser votre code pour mettre à jour tous les commentaires de cette feuille ?

J'ai également remarqué que si je supprime une valeur de "activité midi" ou "activité soir" le commentaire se met bien à jour, mais si je supprimer les 2 valeurs en même temps, le commentaire ne se met pas à jour.

Je vous remercie de votre aide

Cordialement

Salut sylvainpyc,

normal que rien ne se passe lorsque tu effaces deux cellules puisque tu veux toi-même l'interdire !

If Target.Count > 1 Or iRow < 56 Or Target.Column > 390 Then Exit Sub

Un changement dans les lignes "cachées" 'Activités' ou 'Présence FH' ou un clic en [B55] met les commentaires des colonnes visibles à jour.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim sData$, x%, y%
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
If Not Intersect(Target, Range("B55")) Is Nothing Then
    For x = 56 To 182 Step 9
        For y = Range("C1").Resize(Rows.Count, Columns.Count - 2).SpecialCells(xlCellTypeVisible).Column To Cells(55, Columns.Count).End(xlToLeft).Column
            If Cells(x + 2, y) <> "" Or Cells(x + 6, y) <> "" Or Cells(x + 7, y) <> "" Then Call SetComment(x, y)
        Next
    Next
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

A+

Bonjour,

Les commentaires se mettent bien à jour quand je clique sur B55.

Par contre je voudrais qu'apparaisse une * si il y a un commentaire dans la ligne 58 et non une valeur.

Et quand je mets ce code dans mon fichier, ca ne fonctionne plus et ca arrête les macos ?

Est-ce possible svp ?

Je vous remercie de votre aide

Cordialement

La mis à jour des commentaires est facultatif, je peux les refaire manuellement si c'est cela qui me cause une erreur.

Je voudrais surtout svp que qu'apparaisse une * si il y a un commentaire dans la ligne 58 et non une valeur.

Merci

ca m'inquiète, les macros ne fonctionnent plus

J'ai mis votre code sur une copie du fichier officiel mais depuis les macros ne fonctionnent plus

Même quand j'ouvre le fichier officiel sur lequel je n'ai pas fait de modifs

Vous avez une explication svp ?

Salut Sylvain,

je pensais t'avoir envoyé la dernière version. On dirait que non! Je te l'envoie tout à l'heure quand j'aurai accès à l'ordinateur où elle "devrait" se trouver.

Quant à la cause du problème sur celle-ci, je vois, dans 'Stats repas' :

• qu'il manque la Sub SetComment ;
• que End Sub a disparu de la Sub Worksheet_SelectionChange !!

A+