Code VBA insérer un commentaire en fonction de la valeur d'une cellule

Bonjour le forum,

J'ai un fichier Excel qui comprend 2 onglets : "coupon réponse 1Q2019" et "Feuille2".

Dans l'onglet "coupon réponse 1Q2019" les utilisateurs remplissent les cellules des colonnes C, D, E et F en fonction de leur choix. S'ils veulent participer à une sortie et faire 18 trous, ils inscrivent 1 dans la colonne "18T", s'ils veulent faire 9 trous, ils inscrivent 1 dans la colonne "9T", s'ils veulent participer au repas, ils notent 1 dans la colonne "repas", et s'ils veulent une golfette, ils notent 1 dans la colonne "golfette".

Les valeurs des cellules des colonnes C, D et E sont reportées dans l'onglet "Feuille2".

Pour faciliter l'exploitation de ce fichier qui est envoyé à tous les adhérents, je souhaiterai que lorsqu'un adhérent demande une golfette faire 18 trou à une sortie, une macro, insère un commentaire dans la cellule correspondante de la Feuille2.

Voir le fichier joint.

Merci d'avance pour votre aide.

Bonjour,

copier la macro suivante sur la page code de l'onglet "coupon reponse 1Q2019"

Private Sub Worksheet_Change(ByVal Target As Range)
col = Array(3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57)
lig = Array(5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
Set isect = Application.Intersect(Target, Range("F5:F23"))

If Not isect Is Nothing And Target.Count = 1 And Target > 0 Then

    t = Application.Rank(1, Range(Target.Offset(, -3).Address & ":" & Target.Address))
    Select Case t
      Case 1: g = Application.Index(col, Application.Match(Target.Row, lig, 0))
      Case 2: g = Application.Index(col, Application.Match(Target.Row, lig, 0)) + 1
      Case Else: Exit Sub
    End Select

    With Sheets("Feuille2").Cells(3, g)
      If .Comment Is Nothing Then
         .AddComment
          With .Comment
           .Visible = False
           .Text Text:="Golfette partagée"
          End With
      End If
    End With
End If
End Sub

Bonjour sabV, Sergio33600 et le forum,

Je viens de voir le fichier pas pour l'utilisé mais le faire progressé,

Sergio33600 dit :

Pour faciliter l'exploitation de ce fichier qui est envoyé à tous les adhérents, je souhaiterai que lorsqu'un adhérent demande une golfette faire 18 trou à une sortie, une macro, insère un commentaire dans la cellule correspondante de la Feuille2.

Quand on saisie un nom avec 18T cela marche mais si le client change et dis qu'il veut faire un 9T et une golfette !!! le commentaire reste (de la feuille2) sur le 18T

bonne continuation FERDINAND

Bonjour Sergio33600, FERDINAND et à tous,

voici la modification,

à tester,

Private Sub Worksheet_Change(ByVal Target As Range)
col = Array(3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57)
lig = Array(5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
Set isect = Application.Intersect(Target, Range("F5:F23"))
r = Application.Index(col, Application.Match(Target.Row, lig, 0))

If Not isect Is Nothing And Target.Count = 1 Then
     t = Application.Rank(1, Range(Target.Offset(, -3).Address & ":" & Target.Address))

     If Target > 0 And Not IsError(t) Then
        Select Case t
          Case 1: g = r
          Case 2: g = r + 1
          Case 0: Exit Sub
        End Select    

        With Sheets("Feuille2").Cells(3, g)
          If .Comment Is Nothing Then
             .AddComment
              With .Comment
               .Visible = False
               .Text Text:="Golfette partagée"
              End With
          End If
        End With
     End If

     If Target = 0 Then Sheets("Feuille2").Cells(3, r).ClearComments
End If
End Sub

Bonjour sabV,

Merci pour tes réponses.

J'ai un petit soucis, lorsqu'un joueur fait 9 trous et qu'il demande une golfette, le commentaire se met dans la cellule 18 trous au lieu de se mettre dans la cellule 9 trous.

Est-il possible de corriger ?

Encore merci pour ton aide.