XL 2016 Report commentaire ne fonctionne plus ...??

[pika83]

Bonjour , je reviens vers vous car après plusieurs recherche je n'arrive plus a faire fonctionner le report de commentaire ou le code se trouve sur le module 6.
Il est vrai que je ne connais rien en VBA, et ce code issu de M12 que je remercie a nouveau a fonctionner sur un post antérieur. Et maintenant je ne comprend pas pourquoi il ne fonctionne plus.

Dans le fichier, il y a plusieurs onglets dont 2 (CP-OM et OTCM-OMR) qui rapportent leurs valeurs aux autres onglets.
J'aimerais que de l'onglet CP-OM , ou OTCM-OMR les cellules contenant un commentaires soient reporter sur la cellule
des commentaires de l'onglet FdsHebdo et, ou FdSDispo se référant a l'agent concerné. (ceci se réalisant sur l'ensemble des 2 roulements)

Je remet mon donc mon fichier en pièce jointe au cas si quelqu'un ou M12 pourrait m'aider a résoudre ce problème qui pour des expert comme vous n'en est certainement pas un.
D'avance merci pour votre aide

 

[job75]

Bonjour pika83,

Je ne me suis occupé que de la feuille "FdS Hebdo", clic droit sur l'onglet et Visualiser le code :

Private Sub Worksheet_Activate()
Dim P As Range, i&, dat As Long, F As Worksheet, lig As Variant, col As Variant
Application.ScreenUpdating = False
Set P = Range("A1", UsedRange)
P.Columns("H").ClearComments 'RAZ
For i = 1 To P.Rows.Count
    If IsDate(P(i, 2)) Then dat = P(i, 2)
    Set F = Sheets(IIf(P(i, 3) = "CP" Or P(i, 3) = "OM", "CP-OM", "OTCM-OMR"))
    lig = Application.Match(P(i, 4), F.Columns(3), 0)
    col = Application.Match(dat, F.Rows(IIf(F.Name = "CP-OM", 4, 3)), 0)
    If IsNumeric(lig) And IsNumeric(col) Then
        If Not F.Cells(lig, col).Comment Is Nothing Then
            With P(i, "H").AddComment(F.Cells(lig, col).Comment.Text)
                With .Shape.OLEFormat.Object
                    .Font.Bold = True 'gras
                    .AutoSize = True
                End With
                .Visible = True
            End With
        End If
    End If
Next
End Sub

La macro se déclenche quand on active la feuille.

A+

 

[job75]

Fichier (2) si l'on veut seulement entrer le texte du commentaire dans la cellule :

Private Sub Worksheet_Activate()
Dim P As Range, i&, dat As Long, F As Worksheet, lig As Variant, col As Variant
Application.ScreenUpdating = False
Set P = Range("A1", UsedRange)
P.Columns("H") = "" 'RAZ
For i = 1 To P.Rows.Count
    If IsDate(P(i, 2)) Then dat = P(i, 2)
    Set F = Sheets(IIf(P(i, 3) = "CP" Or P(i, 3) = "OM", "CP-OM", "OTCM-OMR"))
    lig = Application.Match(P(i, 4), F.Columns(3), 0)
    col = Application.Match(dat, F.Rows(IIf(F.Name = "CP-OM", 4, 3)), 0)
    If IsNumeric(lig) And IsNumeric(col) Then _
        If Not F.Cells(lig, col).Comment Is Nothing Then P(i, "H") = Replace(F.Cells(lig, col).Comment.Text, vbLf, "")
Next
End Sub

 

[pika83]

merci beaucoup job75, le fichier (2) correspond .

 

[pika83]

merci beaucoup job75, le fichier (2) correspond .

 

[pika83]

Merci beaucoup job75, le fichier (2) correspond a mon attente, même si il m’efface les conditions de certaines cellules qui elles ne prennent pas de commentaire. Mais bon je me suis arrangé d'une autre façon et ca fonctionne bien.
Encore merci et bravo a toi en te souhaite de bonnes fêtes de fin d'année ainsi qu'a tous les membre du forum qui sont super sympas.

 

[pika83]

Dommage que tu n'est pu faire l'onglet FdSDispo, c'est pas grave je vais essayer de le faire avec comme modele le code de l'onglet FdSHebdo et si vraiment je n'y arrive pas, je le posterais.

 

[job75]

Je n'ai pas fait l'onglet "FdS Dispo" parce que je ne vois pas ce qu'il faut faire.

Il faudrait donner un exemple du résultat à obtenir.

 

[job75]

même si il m’efface les conditions de certaines cellules qui elles ne prennent pas de commentaire.

Ah oui je n'avais pas fait assez attention donc prenez ce fichier (3) avec cette macro :

Private Sub Worksheet_Activate()
Dim P As Range, i&, dat As Long, F As Worksheet, lig As Variant, col As Variant
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
Set P = Range("A1", UsedRange)
P.Columns("H").SpecialCells(xlCellTypeConstants) = "" 'RAZ sans toucher aux formules
For i = 1 To P.Rows.Count
    If IsDate(P(i, 2)) Then dat = P(i, 2): P(i + 1, "H") = "Commentaires" 'remet le titre
    Set F = Sheets(IIf(P(i, 3) = "CP" Or P(i, 3) = "OM", "CP-OM", "OTCM-OMR"))
    lig = Application.Match(P(i, 4), F.Columns(3), 0)
    col = Application.Match(dat, F.Rows(IIf(F.Name = "CP-OM", 4, 3)), 0)
    If IsNumeric(lig) And IsNumeric(col) Then _
        If Not F.Cells(lig, col).Comment Is Nothing Then P(i, "H") = Replace(F.Cells(lig, col).Comment.Text, vbLf, " ")
Next
End Sub

 

[pika83]

Bonjour et, merci job75.
Ce que je voulais faire avec l'onglet FdSDispo est la même chose que sur l'onglet FdSHebdo ce que tu as très bien fait et, je te confirme c'est exactement ce que je voulais et il fonctionne bien. Encore bravo et merci.
Je vais essayer de décrire ma démarche :
1- Sur l'onglet FdSDispo je met l’identité de l'agent en I6.
2- Ensuite toujours sur cet onglet je met la date du jour souhaité en F8 (par formule les dates suivantes en F9, F10.... s'affichent automatiquement).
La cellule H8 va se remplir automatiquement car elle contient une formule de Index-Equiv.
En fait je voudrais c'est que dans la cellule I8 elle m'affiche le commentaire s'il y en a un de la cellule M12 de l'onglet OTCM-OMR dans cet exemple, mais doit le faire aussi si l'agent était dans l'onglet CP-OM.
J’espère avoir été assez précis et remet en fichier joint avec les détails.
Encore merci pour ton aide.

 

[job75]

Bonjour pika83, le forum,

C'est maintenant clair, fichier (4) avec cette macro dans le code de la feuille ""FdS Dispo" :

Private Sub Worksheet_Activate()
Dim P As Range, F As Worksheet, lig As Variant, i, col As Variant
Application.ScreenUpdating = False
Set P = [F8:I14] 'à adapter éventuellement
P.Columns(4) = "" 'RAZ
For Each F In Sheets(Array("CP-OM", "OTCM-OMR"))
    lig = Application.Match([I6], F.Columns(3), 0) 'I6 à adapter éventuellement
    If IsNumeric(lig) Then Exit For
Next F
If IsError(lig) Then Exit Sub
For i = 1 To P.Rows.Count
    col = Application.Match(P(i, 1).Value2, F.Rows(IIf(F.Name = "CP-OM", 4, 3)), 0)
    If IsNumeric(col) Then
        If Not F.Cells(lig, col).Comment Is Nothing Then
            P(i, 4) = Replace(F.Cells(lig, col).Comment.Text, vbLf, " ")
            If P(i, 3) <> F.Cells(lig, col) Then MsgBox "Référence non valide en " & P(i, 3).Address(0, 0) 'vérification
        End If
    End If
Next i
End Sub

Notez que la donnée en colonne H est vérifiée.

A+

 

[pika83]

Bravo, c'est exactement ça que je cherchais a faire et tu est arrivé.
Merci beaucoup ton aide m'a été précieuse et m'a permis d'avancer sur ce classeur.
Je clôture donc ce post sur une note très positive et te souhaite de bonnes fêtes de fin d'année.