Insérer un commentaire si...

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais adapter une macro afin d'insérer un commentaire sur une ligne, si le total d'heures dépasse une référence d'heures maxi...

voir fichier joint

Merci pour votre aide si précieuse.

Bien à vous,
Christian

 

[vgendron]

Hello
il faut comparer entre bons formats

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Not Intersect(Target, Range("F18:NG18")) Is Nothing Then
    If Format(Target, "hh:mm") > "08:00" Then
        With Range(Target.Address)
            .AddComment
            .Comment.Text Text:="Heure(s) supplémentaire(s) effectuée(s)"
        End With
    Else: Range(Target.Address).ClearComments
    End If
End If
End Sub

 

[Christian0258]

Re, le forum, vgendron

Merci, vgendron, pour ton code, c'est impec.

Juste une petite question, comment faire référence à une cellule plutôt que ; > "08:00".
La cellule référence se trouve feuille Agent en cellule C36;

Merci encore.

Bien à toi,
Christian

 

[vgendron]

suffit de dire au code où aller chercher la valeur ==> du coup, il faut remodifier le format..

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Not Intersect(Target, Range("F18:NG18")) Is Nothing Then
   
    If Target > Sheets("Agent").Range("C36") * 2 Then
        With Range(Target.Address)
            .AddComment
            .Comment.Text Text:="Heure(s) supplémentaire(s) effectuée(s)"
        End With
    Else: Range(Target.Address).ClearComments
    End If
End If
End Sub

 

[job75]

Bonjour Christian, vgendron,

Un code un peu plus propre :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F18:NG18]) Is Nothing Or Target.Count > 1 Then Exit Sub
Target.ClearComments
If Target > 2 * Sheets("Agent").[C36] Then Target.AddComment "Heure(s) supplémentaire(s) effectuée(s)"
End Sub

A+

 

[job75]

Re,

Une meilleure solution, dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim test As Boolean, h
If Sh.Name = "Agent" Then test = Intersect(Target, Sh.[C36]) Is Nothing
If Sh.Name = "Planning" Then test = Intersect(Target, Sh.[F18:NG18]) Is Nothing
If test Then Exit Sub
h = 2 * Sheets("Agent").[C36]
Application.ScreenUpdating = False
With Sheets("Planning").[F18:NG18]
    .ClearComments
    For Each Target In .Cells
        If Target > h Then Target.AddComment "Heure(s) supplémentaire(s) effectuée(s)"
    Next
End With
End Sub

A+

 

[Christian0258]

Re, le forum, vgendron, job75

Merci à vous, vgendron et job75, pour vos solutions qui fonctionnent parfaitement.

Bien amicalement,

Christian