Macro insertion commentaire

Bonjour à tous, je sollicite votre aide pour une macro qui permettrait d'insérer des commentaires sous conditions. J'ai un fichier avec deux colonnes : article (chaîne de caractère) et date de livraison (date en numéro de semaine dans l'année). L'objectif est que dans un tableau, je répertorie le nombre de livraison dans la semaine et insérer en commentaire les articles concernée par ces livraisons. J'arrive à calculer le nombre de livraison à faire mais il me manque cette macro pour insérer en commentaire la/les article correspondants. Je vous envoie ci joint le fichier.

Merci pour votre implication.

Salut Ah213,

je vois déjà des dates de livraison pour 2023 : comment organises-tu ton tableau RECAP ?
Un tableau RECAP plus complet, histoire de voir comment tu marques les années, serait le bienvenu!


A+

Bonjour,

Si le tableau de données est transformé en tableau structuré nommé t_Articles

Option Explicit

Sub AjoutCommentaire(ByVal Cellule As Range, ByVal Annee As String)

Dim I As Integer
Dim AireArticles As Range
Dim ValeursCumulees As Variant, ValeurATrouver As Variant

    If Cellule = 0 Then Exit Sub

    ValeurATrouver = Cells(2, Cellule.Column)
    ValeursCumulees = ""
    Cellule.ClearComments

    Set AireArticles = Range("t_Articles[Article]")
    For I = 1 To AireArticles.Count
        With AireArticles(I)
             If .Offset(0, 1) = CStr(ValeurATrouver) & "-" & Annee Then
                ValeursCumulees = ValeursCumulees & AireArticles(I) & " "
             End If
        End With
    Next I
    If Len(ValeursCumulees) > 0 Then
       ValeursCumulees = Mid(ValeursCumulees, 1, Len(ValeursCumulees) - 1)

       With Cellule
           ' .ClearComments
            .AddComment
            .Comment.Text Text:=ValeursCumulees
        End With
    End If
    Set AireArticles = Nothing

End Sub

Dans le module de l'onglet Traitement avec l'événement Clic droit :

Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

     If Target.Count > 1 Then Exit Sub

     AjoutCommentaire Target, "2022"
     Cancel = True

End Sub

Salut curulis57 merci pour ta réponse,

Le tableau la semaine 9 à 17 est utilisé pour faire un recap sur le mois actuel et celui à venir. Le mois suivant je le modifie pour avoir Avril Mais et donc semaine 13 14 15 16 17 18 19 20. Chaque mois ce tableau évolue (contrairement aux dates) pour zoomer sur une période donnée et faire un récap dessus.

Salut Ah213,

histoire, si tu veux, bien sûr, d'automatiser un max l'affichage des mois et n° de semaine, comment détermines-tu que la Sem 13 fait partie d'avril alors que le lundi de cette semaine est en mars ?

A+

Rebonjour, merci pour vos réponse.

Je regarde ce que tu as fais Eric et je te fais un retour merci pour ton aide.

Curulis pour la date du tableau, j'ai comme donnée à la base la date sous forme jj/mm/aaaa que je convertis en s-aaaa avec une formule (cf fichier) ensuite dans mon tableau je regarde le numéro de semaine (J2:P2) et en face il correspond à un mois avec la colonne U. Je sais pas si c'est très clair mais il est vrai que délimiter les mois avec les semaines est assez compliqué donc j'ai enlevé la délimitation entre Mars et Avril, à la limite si cet affichage n'est pas automatisé ce n'est pas grave.

Salut Ah,
Salut Eric,

je regarde ça tout à l'heure et te rendrai mon "devoir" en soirée.
Là, beau temps = jardinage !

A+

Sinon pour traiter toutes les cellules :

Sub MajCellulesLivraison()

Dim I As Integer
Dim AireLivraison As Range

    Set AireLivraison = Range("J3:R3")
    For I = 1 To AireLivraison.Count
         AjoutCommentaire AireLivraison(I), "2022"
    Next I
    Set AireLivraison = Nothing

End Sub

Ca marche curulis profites bien de ce soleil

Eric merci pour ces codes et ces instructions ca marche niquel le résultat et celui attendu. Si jamais tu as le temps j'ai deux petites remarques:

-si la colonne article et date de livraison ne sont pas côte à côte (des colonnes les séparent), est-ce que je peux malgré tout sélectionner ces colonnes pour créer un tableau structurée?

-si je modifie une date de livraison, comment enlever le commentaire de l'article lié à cette dernière date de livraison modifiée?

Si les deux colonnes font parties du même tableaux structuré, je crée deux variables Range :

Sub AjoutCommentaire(ByVal Cellule As Range, ByVal Annee As String)

Dim I As Integer
Dim AireArticles As Range, AireDatesPrevues As Range
Dim ValeursCumulees As Variant, ValeurATrouver As Variant

    If Cellule = 0 Then Exit Sub

    ValeurATrouver = Cells(2, Cellule.Column)
    ValeursCumulees = ""
    Cellule.ClearComments

    Set AireArticles = Range("t_Articles[Article]")
    Set AireDatesPrevues = Range("t_Articles[Date livraison prévue]")

    For I = 1 To AireArticles.Count
        With AireArticles(I)
             If AireDatesPrevues(I) = CStr(ValeurATrouver) & "-" & Annee Then
                ValeursCumulees = ValeursCumulees & AireArticles(I) & " "
             End If
        End With
    Next I
    If Len(ValeursCumulees) > 0 Then
       ValeursCumulees = Mid(ValeursCumulees, 1, Len(ValeursCumulees) - 1)

       With Cellule
           ' .ClearComments
            .AddComment
            .Comment.Text Text:=ValeursCumulees
        End With
    End If
    Set AireArticles = Nothing: Set AireDatesPrevues = Nothing

End Sub

Sinon avec la procédure MajCellulesLivraison, les commentaires sont obligatoirement recalculés.

Salut Ah,
Salut Eric,

mon devoir...
À l'ouverture, une macro redessine éventuellement le tableau en fonction du nombre de semaines de la période.
Ce calcul est tablé sur la date de la période en cours cachée en [I2].
La semaine en cours est soulignée d'une couleur différente.

La macro SetComm() calcule les commentaires en se basant sur les 3 colonnes en [U:V:W].
- s'il reste un colis "en retard" de livraison encore signalé dans cette liste, le chiffre correspondant en ligne 3 s'inscrit en rouge.
Toute modification dans la liste des colis se traduit par un recalcul du tableau.
- pour supprimer un colis de la liste, un clic DROIT supprime la ligne concernée.
- tu peux aussi supprimer une ou plusieurs ligne de colis en sélectionnant cette ou ces lignes pourvu que ta sélection comporte au moins 3 colonnes.

Public Sub SetComm()
'
Dim tTab, iNb%, iColor%, sComm$
'
With Worksheets("Traitement")
    tTab = .Range("U2:W" & .Range("V" & Rows.Count).End(xlUp).Row).Value
    For x = 10 To .Range("J2").End(xlToRight).Column
        iNb = 0
        sComm = ""
        .Range(fctCol(x) & 3).Value = ""
        .Range(fctCol(x) & 3).ClearComments
        For y = 1 To UBound(tTab, 1)
            If CInt(Split(tTab(y, 2), "-")(0)) = CInt(.Range(fctCol(x) & 2).Value) And CDate(tTab(y, 3)) <= DateAdd("m", 2, .[I2]) - 1 Then _
                iNb = iNb + 1: _
                sComm = sComm & IIf(sComm = "", "", Chr(10)) & tTab(y, 1): _
                iColor = IIf(DatePart("ww", CDate(tTab(y, 3)), vbMonday, vbFirstFourDays) < DatePart("ww", Date, vbMonday, vbFirstFourDays), 3, 1)
        Next
        If sComm <> "" Then
            .Range(fctCol(x) & 3).Value = iNb
            .Range(fctCol(x) & 3).Font.Color = IIf(iColor = 1, RGB(0, 0, 0), RGB(255, 0, 0))
            .Range(fctCol(x) & 3).Font.Bold = IIf(iColor = 1, False, True)
            .Range(fctCol(x) & 3).AddComment
            With .Range(fctCol(x) & 3).Comment
                .Shape.AutoShapeType = msoShapeRoundedRectangle
                .Shape.TextFrame.Characters.Font.Name = "Times New Roman"
                .Shape.TextFrame.Characters.Font.Size = 8
                .Shape.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
                .Shape.Line.ForeColor.RGB = RGB(0, 0, 0)
                .Text sComm
                .Shape.TextFrame.AutoSize = True
            End With
        End If
    Next
End With
'
End Sub

A+

Salut Curulis,

Merci pour ton aide et ton travail. C'est plus que ce que je demandais mais c'est parfait ca fonctionne parfaitement. J'opte pour ta solution. Merci encore et je te souhaites de passer une bonne journée