Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 compiler cellule dans un commentaire

limagerit

XLDnaute Occasionnel
Bonjour à tous ,

Je cherche une solution pour compiler plusieurs cellules sur plusieurs onglets dans un même commentaire.
J'ai une référence commune dans chaque base ,
J'ai essayé via les formules concatener mais l'ajout en commentaire me dépasse.

J'en appelle donc à la toute puissance des experts macros.

ci joint l'exemple .

Merci de votre aide
 

Pièces jointes

  • commentaire.xlsx
    11.8 KB · Affichages: 5

Eric KERGRESSE

XLDnaute Occasionnel
Bonjour,

Pour déclencher la macro, le bouton vert dans la barre d'accès rapide.

Dans un module standard d'un fichier .xlsm :

VB:
Sub MajCommentaires()

Dim I As Long, DerniereLigne As Long
   
    With Sheets("bilan")
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         For I = 1 To DerniereLigne
             With .Cells(I, 1)
                  If Not .Comment Is Nothing Then
                         .Comment.Delete
                         .AddComment Text:=InfoCommentaire(.Value)
                  Else
                         .AddComment Text:=InfoCommentaire(.Value)
                  End If
                  .Comment.Visible = False
             End With
         Next I
    End With

End Sub


Function InfoCommentaire(ByVal Reference As String) As String

Dim I As Long, DerniereLigne As Long

    InfoCommentaire = ""
   
    With Sheets("Prix")
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         For I = 1 To DerniereLigne
             If .Cells(I, 1) = Reference Then
                InfoCommentaire = .Cells(I, 2) & " " & .Cells(I, 3) & " € " & .Cells(I, 4) & Chr(10)
             End If
         Next I
    End With
   
    With Sheets("Geo")
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         For I = 1 To DerniereLigne
             If .Cells(I, 1) = Reference Then
                InfoCommentaire = InfoCommentaire & .Cells(I, 2)
             End If
         Next I
    End With
   

End Function
 

Pièces jointes

  • Limagerit commentaire.xlsm
    23.1 KB · Affichages: 8

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous ,

Ma p'tite version...

Les commentaires se mettent à jour :
à l'ouverture du classeur
à chaque sélection de la feuille "Bilan"

il y a du code :
  • 3 lignes dans le module de code de ThisWorkbook (pour lancer CommBilan à l'ouverture du classeur)
  • 3 lignes dans le module de code de la feuille "Bilan" (pour lancer CommBilan à l'activation de la feuille)
  • dans Module1 pour le code de la procédure principale CommBilan()
Code de CommBilan dans Module1 :
VB:
Sub CommBilan()
Dim shBil As Worksheet, shpri As Worksheet, shgeo As Worksheet, x As Range, np&, ng&, xcomm
   Set shBil = Worksheets("bilan"): Set shpri = Worksheets("prix"): Set shgeo = Worksheets("geo")
   Application.ScreenUpdating = False
   With shBil
      For Each x In Intersect(.Columns("a"), .UsedRange)
         xcomm = ""
         If x.Row <> 1 Then
            If Len(x) = 0 Then
               If Not x.Comment Is Nothing Then x.Comment.Delete
            Else
               np = Application.IfError(Application.Match(x, shpri.Columns(1), 0), -1)
               ng = Application.IfError(Application.Match(x, shgeo.Columns(1), 0), -1)
               If np > 1 Then
                  xcomm = shpri.Cells(np, 2) & " / " & shpri.Cells(np, 3).Text
                  xcomm = xcomm & " / " & shpri.Cells(np, 4)
               End If
               If ng > 1 Then xcomm = xcomm & vbLf & shgeo.Cells(ng, 2)
               If x.Comment Is Nothing Then x.AddComment
               x.Comment.Visible = False: x.Comment.Text Text:=xcomm
            End If
         End If
      Next x
   End With
End Sub
 

Pièces jointes

  • limagerit- commentaire- v1.xlsm
    24.2 KB · Affichages: 8
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…