Commentaire conditionnel

Question

Je cherche à créer une macro qui m'ajoute un commentaire. Ma base est celle ci : Sub test2() With Range("W2") .AddComment .Comment.Visible = False .Comment.Text Text:=Worksheets("relevé encodages").Range("D2").Value & Chr(10) & Worksheets("relevé encodages").Range("G2").Value & Chr(10) & Worksheets("relevé encodages").Range("I2").Value With Range("W2").Comment.Shape .TextFrame.AutoSize = True .OLEFormat.Object.Font.Size = 10 'Taille du texte .OLEFormat.Object.Interior.ColorIndex = 33 'Couleur de fond .TextFrame.Characters.Font.ColorIndex = 11 'Couleur de la police .TextFrame.Characters.Font.Bold = False 'Gras ou non .OLEFormat.Object.Font.Name = "Bangle" 'Type de police End With End With End Sub Ca fonctionne, mais, il me manque 3 choses : * Ce que je cherche à obtenir c'est que ce commentaire soit soumis à condition, c'est à dire que le commentaire ne doit se mettre que si La cellule L2 de ma feuille "relevé encodages" est égale à la cellule L7 de ma feuille "TM" ET La cellule H2 de ma feuille "relevé encodages" est égale à la cellule C7 de ma feuille "TM" Si ces 2 conditions ne sont pas remplies il ne faut pas de commentaire * Je peux avoir plusieurs résultats conditionnels VRAI, où les deux conditions sont remplies plusieurs fois, auquel cas le commentaire doit alors reprendre tous les résultats VRAI * Et plutot que de se mettre uniquement en W2, le commentaire doit pouvoir se mettre sur toutes les cellules de ma colonne W Un fichier valant mieux que de grands discours, le voici en pièce jointe. J'ai indiqué dans la première cellule concernée de la colonne W le résultat auquel j'essaie de parvenir Merci beaucoup, bonne après midi Lorence...

Curulis · Accepted Answer

Devrait ressembler à ceci... La macro de mise à jour des commentaires se déclenche à l'activation de la feuille ' TM ' Private Sub Worksheet_Activate() ' Dim sWkRE As Worksheet, rCel As Range, tTab, sComm$ ' Application.ScreenUpdating = False Set sWkRE = Worksheets("Relevé encodages") tTab = sWkRE.Range("A2:L" & sWkRE.Range("B" & Rows.Count).End(xlUp).Row).Value ' For x = 7 To Range("B" & Rows.Count).End(xlUp).Row sAM = Range("B" & x).Value sCl = Range("C" & x).Value Range("W" & x).ClearComments Set rCel = Range("W" & x) sComm = "" For y = 1 To UBound(tTab, 1) If tTab(y, 12) = sAM And sCl = tTab(y, 8) Then _ sComm = sComm & IIf(sComm = "", "", Chr(10)) & tTab(y, 4) & " - " & tTab(y, 7) & " - " & tTab(y, 9) Next If sComm &lt;&gt; "" Then Call CommCHGT(rCel, sComm) Next ' Application.ScreenUpdating = True ' End Sub A+...

xorsankukai · Answer

Bonjour Lorence , le forum, Juste en jetant un petit coup d’œil à ton code, je relève quelques manquements: If Worksheets("TM").Range("B" & i) = Worksheets("relevé encodages").Range("L") And Worksheets("TM").Range("C" & i) = Worksheets("relevé encodages").Range("H") Then Quelle ligne pour L ? Quelle ligne pour H ? .Comment.Text Text:=Worksheets("relevé encodages").Range("D").Value & Chr(10) & Worksheets("relevé encodages").Range("G").Value & Chr(10) & Worksheets("relevé encodages").Range("I").Value Quelle ligne pour D ? Quelle ligne pour G ? Quelle ligne pour I ? Cordialement...

xorsankukai · Answer

Re,

Pas certain d'avoir compris le besoin, un essai à tout hasard...à partir de tes codes...

Sub essai()
 Dim dl%, derlig%, shTM As Worksheet, shRE As Worksheet, msg As String
   Set shTM = Sheets("TM")
   Set shRE = Sheets("relevé encodages")
         dl = shTM.Range("A" & Rows.Count).End(xlUp).Row
     derlig = shRE.Range("B" & Rows.Count).End(xlUp).Row

     shTM.Range("W7:W" & derlig).ClearComments

Application.ScreenUpdating = False

 For i = 7 To dl
  For j = 2 To derlig
   If shTM.Range("B" & i) = shRE.Range("L" & j) And shTM.Range("C" & i) = shRE.Range("H" & j) Then
    msg = msg & Chr(10) & shRE.Range("D" & j).Value & " - " & shRE.Range("G" & j).Value & " - " & shRE.Range("I" & j).Value
   End If
  Next j
   If msg <> "" Then
    With shTM.Range("W" & i)
    .AddComment
    .Comment.Visible = False
    .Comment.Text Text:=msg
     With .Comment.Shape
     .TextFrame.AutoSize = True
     .OLEFormat.Object.Font.Size = 10 'Taille du texte
     .OLEFormat.Object.Interior.ColorIndex = 33 'Couleur de fond
     .TextFrame.Characters.Font.ColorIndex = 11 'Couleur de la police
     .TextFrame.Characters.Font.Bold = False 'Gras ou non
     .OLEFormat.Object.Font.Name = "Bangle" 'Type de police
     End With
    End With
   End If
   msg = ""
 Next i
 Set shTM = Nothing: Set shRE = Nothing
End Sub

[EDIT] : le fichier...la macro se nomme Essai

10lorence.xlsm (249.33 Ko)

Cordialement,

xorsankukai · Answer

Bonjour Curulis57 , La classe comme toujours, tu es déconcertant de facilité, Mais je suis ravi de constater que j'obtiens bien le même résultat, Amitiés...

Curulis · Answer

Vous allez me faire rougir, grands sots !!...

Curulis · Answer

Je crois que Xor est candidat ! Après tout, il est tout aussi efficace et lui, c'est un héros ! A+...