copier un commentaire via une formule (RESOLU)

R

reitre

XLDnaute Nouveau
Bonjour à tous et merci à vous si vous prenez le temps de me lire ;)

J'ai mis au point un calendrier qui gère les absences du personnel. Il est sous forme de tableau à double entrée :

- en ligne, le personnel
- en colonne, les dates

a la case qui fait l'intersection de chaque entrée, on sait si ce personnel est présent et absent, et, s'il est absent, où il se trouve (ex : "en congé", "à l'étranger", etc).

Ces cases du calendrier sont renseignées grâce à une formule, qui lie ces cases à d'autres cellules. Or, j'aimerai que cette formule, outre copier la valeur de la cellule XX, copie également le commentaire de cette cellule XX.

Par exemple, si le personnel est à l'étranger, j'ai déjà spécifié dans le commentaire de la cellule XX quel était le pays concerné. J'aimerai que ce commentaire-pays se retrouve dans le calendrier.

Quelqu'un sait-il comment s'y prendre ? Et j'espère avoir été clair ^^

J'ai essayé de remédier à ce problème par VBA, mais c'est tellement compliqué que cela me simplifierait la vie si il y avait un autre moyen !
 
Dernière édition:
Trier par date Trier par votes
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Bonjour,


Dans le module de la feuille où l'action se déroule, copie la procédure suivante :

J'ai supposé que tu entrais tes commentaires manuellement dans la colonne C
et que tu voulais ajouter un commentaire sur la colonne B.

Tu adaptes selon ton application


VB: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rg As Range, C As Range
Set Rg = Intersect(Target, Range("C:C"))

If Not Rg Is Nothing Then
    On Error Resume Next
    For Each C In Rg
        If C.Value = "" Then
            'Commentaire dans la colonne B
            C.Offset(, -1).Comment.Delete
        Else
            C.Offset(, -1).AddComment C.Value
        End If
    Next
End If

End Sub
 
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

Merci pour la réponse rapide !

MichD à dit:
Bonjour,


Dans le module de la feuille où l'action se déroule, copie la procédure suivante :

J'ai supposé que tu entrais tes commentaires manuellement dans la colonne C
et que tu voulais ajouter un commentaire sur la colonne B.
Cliquez pour agrandir...

C'est là que le bât blesse : ton code semble supposer que la cellule XX (celle d'origine, avec le commentaire) est sur la même ligne que la cellule YY (celle où je veux ajouter le commentaire). Or, c'est rarement le cas.

Je te joins un calendrier-exemple pour que tu comprennes où je veux en venir.
 

Pièces jointes

  • Exemple calendrier.xls
    67 KB · Affichages: 61
  • Exemple calendrier.xls
    67 KB · Affichages: 56
  • Exemple calendrier.xls
    67 KB · Affichages: 63
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Essaie ceci :


VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Rg As Range, C As Range, Plg As Range
Dim Trouve As Range, Adr As String

Set Rg = Intersect(Target, Range("D:D"))
If Not Rg Is Nothing Then
     On Error Resume Next
     For Each C In Rg
        Set Plg = Range("G" & C.Row & ":" & "AK" & C.Row)
        With Plg
            Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, _
                        searchdirection:=xlNext, MatchCase:=False)
            If Not Trouve Is Nothing Then
                Adr = Trouve.Address
                Do
                    Trouve.Comment.Delete
                    Trouve.AddComment C.Value
                    Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
                    Set Trouve = .FindNext(Trouve)
                Loop Until Trouve.Address = Adr
            End If
        End With
     Next
End If
End Sub
 
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Ton fichier retourné avec la macro incluse.

Dans la colonne D3 à 12, chaque fois que tu inscris une des étiquettes
réservées (A l'étranger, congé...) les commentaires sont ajoutés.

Tu peux faire seulement un double-clique dans chacune de ces cellules
et observe la présence des commentaires.

Si tu veux que la macro se déclenche autrement, il faut le dire!
 

Pièces jointes

  • Exemple calendrier.xls
    74.5 KB · Affichages: 49
  • Exemple calendrier.xls
    74.5 KB · Affichages: 51
  • Exemple calendrier.xls
    74.5 KB · Affichages: 49
Dernière édition:
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

Bonjour,

merci pour le travail effectué. Ce n'était pas tout à fait ce que je cherchai, donc j'ai passé les deux derniers jours à essayer de modifier ce que tu avais déjà fait pour l'arranger comme je le souhaite, mais je n'y arrive toujours pas:eek:

Voilà mon problème :

Dans la colonne D3 à 12, chaque fois que tu inscris une des étiquettes
réservées (A l'étranger, congé...) les commentaires sont ajoutés.
Cliquez pour agrandir...

ce qui apparait en commentaire dans le calendrier est l'étiquette de le colonne D. Ce que je voudrai, c'est que le pays de destination apparaisse en commentaire, si jamais l'étiquette de la colonne D a pour valeur "A l'étranger".

Donc deux solutions :
  • soit il y a déjà un commentaire dans l'étiquette de la colonne D (j'avais mis les exemples Allemagne, Birmanie, Grèce), auquel cas la macro copie ce commentaire et la met dans le calendrier(toujours en commentaire). C'est ce que je demandai de manière peu claire dans le premier post.
  • soit je mets le nom du pays dans la colonne E. Auquel cas, la macro copie la valeur de la colonne E, et l'insère en commentaire dans la cellule du calendrier qui correspond à cette ligne. Cela me parait plus facile à mettre en place, au vu de ta macro.

La macro qui se déclenche automatiquement est bien ce qu'il me fallait, sinon.

Qu'en penses-tu, et comment faire ?
 
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Remplace par ceci :


VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
  
Dim Rg As Range, C As Range, Plg As Range
Dim Trouve As Range, Adr As String, Ville As String
 
Set Rg = Intersect(Target, Range("D:D"))
 If Not Rg Is Nothing Then
      On Error Resume Next
      For Each C In Rg
        If UCase(C.Value) = UCase("A l'étranger") Then
            Ville = C.NoteText
            Set Plg = Range("G" & C.Row & ":" & "AK" & C.Row)
            With Plg
                Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
                         LookAt:=xlWhole, SearchOrder:=xlByRows, _
                         searchdirection:=xlNext, MatchCase:=False)
                If Not Trouve Is Nothing Then
                    Adr = Trouve.Address
                    Do
                        Trouve.Comment.Delete
                        Trouve.AddComment Ville
                        Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
                        Set Trouve = .FindNext(Trouve)
                    Loop Until Trouve.Address = Adr
                End If
            End With
        End If
      Next
 End If
 End Sub
 
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

Excellent ! Merci ! C'est presque fini !

Oui, car il resterait un dernier détail à régler. C'est ce qui m'a demandé le plus de temps lorsque j'ai essayé de résoudre ce problème moi-même.

Le code fait :

Set Plg = Range("G" & C.Row & ":" & "AK" & C.Row)
Cliquez pour agrandir...

Or, la ligne des deux cellules (source et calendrier) n'est pas forcément commune. Par exemple, Pierre, dans le tableau source, est ligne 11, alors qu'il est en ligne 7 du calendrier. Et ce, parce que la même personne peut avoir plusieurs absences par mois.


  • J'avais essayé de mettre au point un code pour rechercher la cellule "source d'une formule". Par exemple, I3 fait référence à D3, donc si un tel code existe, une formule qui permet de remonter la chaîne jusqu'à D3


  • Ou alors, jouer avec la date, que lon trouve ligne 2. Par exemple, un code avec If "B" & C.Row >= ??? etc. Je sais que c'est sûrment faisable, là encore, mais je m'embrouille complètement et ne sait pas commencer le code.
 
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Comme ceci :


VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   
Dim Rg As Range, C As Range, Plg As Range, Usager As String
 Dim Trouve As Range, Adr As String, Ville As String, Ligne As Variant
  
Set Rg = Intersect(Target, Range("D:D"))
  If Not Rg Is Nothing Then
       On Error Resume Next
       For Each C In Rg
         If UCase(C.Value) = UCase("A l'étranger") Then
             Ville = C.NoteText
             Usager = C.Offset(, -3).Value
             Ligne = Application.Match(Usager, Range("F:F"), 0)
             If Not IsError(Ligne) Then
                Set Plg = Range("G" & Ligne & ":" & "AK" & Ligne)
                With Plg
                    Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, _
                          searchdirection:=xlNext, MatchCase:=False)
                    If Not Trouve Is Nothing Then
                        Adr = Trouve.Address
                        Do
                            Trouve.Comment.Delete
                            Trouve.AddComment Ville
                            Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
                            Set Trouve = .FindNext(Trouve)
                        Loop Until Trouve.Address = Adr
                    End If
                End With
            Else
                Err = 0
            End If
         End If
       Next
  End If
End Sub
 
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

AHah ! On touche la fin. C'est bien ce que je demandais. Le petit problème qu'il me reste est d'ordre pratique maintenant.

La macro s'exécute seulement si je change la valeur des cellules de la colonne D. Or, J'aimerai que cela se fasse automatique, par exemple si je change seulement la valeur du commentaire.

Dans mon document originel, j'ai un bouton "mise à jour". Si cela facilite le code, on peut faire en sorte que la macro se déclenche lorsqu'on appuie sur ce bouton, en plus d'autres macros.

Et enfin, question subsidiaire : combien de temps mets-tu à écrire un tel code ?

Merci !
 
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Tu places ce code dans la FEUILLE MODULE où l'action se déroule et
tu peux l'attacher à un bouton de la barre d'outils formulaire.

Avant de lancer la mise à jour, tu sélectionnes la ou les cellules de
la colonne D que tu veux mettre à jour.

Ce code est relativement simple à écrire avec un peu de pratique.
Je ne me suis jamais chronométré, mais je dirais environ 15 minutes
le temps de le taper et de conduire un ou deux tests.

C'est beaucoup plus long lorsque l'usager énonce au compte-goutee ce
qu'il désire et que l'on doit créer plusieurs versions...

VB: 
Sub Mise_A_Jour()
   
Dim Rg As Range, C As Range, Plg As Range, Usager As String
 Dim Trouve As Range, Adr As String, Ville As String, Ligne As Variant
  
If TypeName(Selection) = "Range" Then
    Set Rg = Intersect(Selection, Range("D:D"))
    If Not Rg Is Nothing Then
       On Error Resume Next
       For Each C In Rg
         If UCase(C.Value) = UCase("A l'étranger") Then
             Ville = C.NoteText
             Usager = C.Offset(, -3).Value
             Ligne = Application.Match(Usager, Range("F:F"), 0)
             If Not IsError(Ligne) Then
                Set Plg = Range("G" & Ligne & ":" & "AK" & Ligne)
                With Plg
                    Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, _
                          searchdirection:=xlNext, MatchCase:=False)
                    If Not Trouve Is Nothing Then
                        Adr = Trouve.Address
                        Do
                            Trouve.Comment.Delete
                            Trouve.AddComment Ville
                            Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
                            Set Trouve = .FindNext(Trouve)
                        Loop Until Trouve.Address = Adr
                    End If
                End With
            Else
                Err = 0
            End If
         End If
       Next
  End If
End If
End Sub
 
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

MichD à dit:
C'est beaucoup plus long lorsque l'usager énonce au compte-goutee ce
qu'il désire et que l'on doit créer plusieurs versions...
Cliquez pour agrandir...

Autant pour moi ! C'est que les besoins s'affinent ou sont mal exprimés au début.

J'ai copié ce que tu m'as donné, et cela marche très bien. Je l'ai transposé dans mon fichier originel, mais après quelques temps passé sur celui-ci, je me suis rendu compte d'un problème : en cas de plusieurs absences " A l'étranger" dans le même mois pour une seule personne, seul un des commentaires est insrit dans le calendrier.

Par exemple, si pierre part du 10/01 au 15/01 au Pérou, et du 20/01 au 25/01 en Bolivie, les commentaires des cases du calendrier auront toutes soit Pérou, soit Bolivie, quelles que soient les dates.

J'ai essayé de créer deux nouveaux String (Datedébut et Datefin) et deux variantes, comme je te montre en dessous, en recopiant ce que tu avais déjà fait , mais il me dit "erreur : argument non facultatif" si Colonnedébut = range, et "sub oiu fonction non défini" si Colonnedébut = Column.

Code: 
Sub Mise_A_Jour()
   
Dim Rg As Range, C As Range, Plg As Range, Usager As String, Datedébut As String, Datefin As String
 Dim Trouve As Range, Adr As String, Ville As String, Ligne As Variant, ColonneDébut As Variant, ColonneFin As Variant
  
Sheets("Feuil1").Range("D:D").Select
  
If TypeName(Selection) = "Range" Then
    Set Rg = Intersect(Selection, Range("D:D"))
    If Not Rg Is Nothing Then
       On Error Resume Next
       For Each C In Rg
         If UCase(C.Value) = UCase("A l'étranger") Then
             Ville = C.NoteText
             Usager = C.Offset(, -3).Value
             Datedébut = C.Offset(, -2).Value
             Datefin = C.Offset(, -1).Value
             ColonneDébut = Column(, Datedébut, Range("2:2"))
             ColonneFin = Range(, Datefin, Range("2:2"))

             Ligne = Application.Match(Usager, Range("F:F"), 0)
             If Not IsError(Ligne) Then
                Set Plg = Range("ColonneDébut" & Ligne & ":" & "ColonneFin" & Ligne)
                With Plg
                    Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, _
                          searchdirection:=xlNext, MatchCase:=False)
                    If Not Trouve Is Nothing Then
                        Adr = Trouve.Address
                        Do
                            Trouve.Comment.Delete
                            Trouve.AddComment Ville
                            Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
                            Set Trouve = .FindNext(Trouve)
                        Loop Until Trouve.Address = Adr
                    End If
                End With
            Else
                Err = 0
            End If
         End If
       Next
  End If
End If
End Sub
 
Vote positif 0 Vote négatif
M

MichD

XLDnaute Impliqué
Re : copier un commentaire via une formule

Essaie comme ceci :


VB: 
Sub Mise_A_Jour()
    
Dim Rg As Range, C As Range, Usager As String, Cel As Range
Dim Ville As String, Ligne As Variant
Dim FirstCol As Integer, LastCol As Integer
 
If TypeName(Selection) = "Range" Then
    Set Rg = Intersect(Selection, Range("D:D"))
    If Not Rg Is Nothing Then
        'On Error Resume Next
        For Each C In Rg
            If UCase(C.Value) = UCase("A l'étranger") Then
                Ville = C.NoteText
                Usager = C.Offset(, -3).Value
                Ligne = Application.Match(Usager, Range("F:F"), 0)
                FirstCol = Application.Match(CLng(C.Offset(, -2)), Range("G2:AK2"), 0)
                LastCol = Application.Match(CLng(C.Offset(, -1)), Range("G2:AK2"), 0)
                If Not IsError(Ligne) Then
                    For Each Cel In Range(Cells(Ligne, FirstCol + 6), Cells(Ligne, LastCol + 6))
                        Cel.ClearComments
                        Cel.AddComment Ville
                        Cel.Comment.Shape.OLEFormat.Object.AutoSize = True
                    Next
                Else
                    Err = 0
                End If
             End If
        Next
   End If
End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
R

reitre

XLDnaute Nouveau
Re : copier un commentaire via une formule

Merci, cependant avec la macro précédente, je pouvais sélectionner la colonne D et lancer la macro pour qu'elle soit lancée. Là, il faut réellement sélectionner les cellules une à une. Or, je ne peux pas demander à mes usagers du calendrier d'aller chercher dans le tableau (qui fera plusieurs dizaines de ligne) toutes les cellules. N'y a t-il pas un moyen de dire "For Each C.Value = "A l'étranger" etc ?
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2021 Duplication d'onglets dans un nouveau fichier et enregistrement selon une cellule donnée
Réponses
7
Affichages
195
wDog66
wDog66
J
  • Résolu(e)
XL 2019 Détection de texte dans une Cellule pour le Copier et Coller dans un autre tableau
2 3
Réponses
40
Affichages
445
Phil69970
Phil69970
B
  • Question
Microsoft 365 Excel - Formule de calcul
Réponses
4
Affichages
144
Ben92290
B
I
  • Question
XL 2019 Suite à une formule, enlever le doublon dans le résultat avec fonction SI
Réponses
2
Affichages
139
IderMTC
I
B
  • Question
Microsoft 365 Excel - formule de calcul complexe
Réponses
4
Affichages
364
Ben92290
B
F
  • Résolu(e)
Microsoft 365 Extraire le code pays d'une référence avec un code VBA
2 3
Réponses
40
Affichages
1 K
Faroyo
F
D
  • Question
XL 2021 Fonction vba recherche& extraire un commentaire sur une ligne
2
Réponses
27
Affichages
1 K
didier.007
D
M
  • Question
Microsoft 365 Impossible de copier une formule
Réponses
3
Affichages
104
moanin
M
E
  • Résolu(e)
Autres suppression de l'erreur #ref dans une formule de calcul
Réponses
4
Affichages
282
ermagat
E
C
  • Résolu(e)
XL 2021 Aléa entre borne et ne pas prendre en compte cellule vide
Réponses
11
Affichages
560
candido57
C

Membres actuellement en ligne

15 membres et 203 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 555
Messages
2 089 561
Membres
104 211
dernier inscrit
clubdesjeunesdela7