INFO bulle et commentaire

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jeromeN95
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
jeromeN95

jeromeN95

XLDnaute Impliqué
Bonjour, je souhaite récuperer les informations de cellules dans une info bulle :

Sur l'onglet "Exp+" en C16, faire apparaitre une info bulle en fonction :
-du produit (la recherche se fait automatiquement)
-du contenu des cellules (en colonne AJ à AY) en fonction du produit.

Par exemple en C16 j'ai Personril4KL1, le commentaire doit etre :
Code: 
Dosage : 6
Utilisation au lavage
Contre indication Linge 1 : Nylon
Contre indication Linge 2 : Polyamide
Contre indication Linge 3 : Laine
Contre indication Température : 40 à 70°
Contre indication Temps : 7 minutes
Contre indication Ph = 9 à 10

J'ai mis un bon exemple sur le fichier joint
J'ai commencer le code mais ne m'en sort plus....


Helpe SVP.
 

Pièces jointes

Trier par date Trier par votes
Re : INFO bulle et commentaire

Bonjour,
Pour une seule cellule parce que si je peux me permettre, c'est un peu le foutoir tout de même
Dans le module de la feuille...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x%, i As Byte, T$, c As Range, cmt As Comment
If Target.Address = "$G$16" And Target.Count = 1 Then
    x = Application.Match(Target, Sheets("RExp+").[NomProd], 0) + 1
    With [InfoProd]
        For i = 1 To .Columns.Count
            If .Cells(x, i) <> 0 Then
                T = T & .Cells(1, i) & ": " & .Cells(x, i) & vbLf
            End If
        Next
    End With
    Set c = Sheets("Exp+").Range("C16")
    With c
        .Value = Target
        On Error Resume Next
        .Comment.Delete
        On Error GoTo 0
        Set cmt = .AddComment(Left(T, Len(T) - 1))
        cmt.Shape.TextFrame.AutoSize = True
    End With
End If
End Sub

Edit : salut PierreJean...
A+
kjin
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Salut Pierre Jean et merci de ta réponse rapide.
Oar contre j'arrive pas a tester car j'ai une erreur de bibliotheque...

Salut Kjin, et merci a toi aussi.
C'est exactement ça que je voulait.
Ya pas mieux
merci beaucoup!!!!
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Re

Pour l'erreur de bibliotheque:
Aller dans outils References et decocher si erreur
version enregistrée à partir de Excel2000
Mais vu le peu d'ecart entre ma version et celle de Kjin (que je salue) ce n'est que pour le fun
 

Pièces jointes

Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Ué, en fait j'ai pris le tient PierreJean.
Il fonctionne d'une maniere plus "simple" sous forme de module et un simple appel de fonction call Bulle.

Sans erreur cette fois.

Merci.
Je voit que j'ai en C24 et C16 pour le détergent. Comment on fait pour faire pareil avec les autres type de produit? Renforcateur, blanchimement, assouplissant??

Merci.
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Alors j'ai trouver mais :

Code: 
Sub bulle()
For n = 16 To Sheets("Exp+").Range("C65536").End(xlUp).Row
 If Sheets("Exp+").Range("C" & n) <> "" Then
  Set c = Sheets("RExp+").Columns("AE").Find(Sheets("Exp+").Range("C" & n), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    For m = numcol("AJ") To numcol("AX")
      If Sheets("RExp+").Cells(c.Row, m) <> 0 Then
        If Sheets("RExp+").Cells(c.Row, m) = "X" Then
          letexte = letexte & Sheets("RExp+").Cells(1, m) & Chr(10)
        Else
          letexte = letexte & Sheets("RExp+").Cells(1, m) & ": " & Sheets("RExp+").Cells(c.Row, m) & Chr(10)
        End If
      End If
    Next m
      On Error Resume Next
        Sheets("Exp+").Range("C" & n).Comment.Delete
[B]        Sheets("Exp+").Range("H" & n).Comment.Delete[/B]
      On Error Resume Next
      Sheets("Exp+").Range("C" & n).AddComment letexte
[B]      Sheets("Exp+").Range("H" & n).AddComment letexte[/B]      Sheets("Exp+").Range("C" & n).Comment.Shape.TextFrame.AutoSize = True
[B]      Sheets("Exp+").Range("H" & n).Comment.Shape.TextFrame.AutoSize = True[/B]      letexte = ""
  End If
 End If
Next n
End Sub

Par contre j'ai 6 types de produits.
On peut faire plus court?

Egalement, ca me met les commentaires partout dans les colonnes en faisant ça, je souhaite les commentaires uniquements dans les cellules où il y a le nom.
--> C16 et C24 pour détérgent
--> C17 et E24 pour blanchiment
--> C18 et F24 pour Alcalin
--> C19 et H24 pour Assouplissant
--> C20 et I24 pour dégraissant
--> C21 et K24 pour Autres

Merci énormement pour tout PierreJean.
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Re

Peux-tu repreciser ton probleme S.T.P ?
Avec si possible un fichier et une idée des resultats attendus (les commentaires ne doivent pas necessairement etre complets):
comment doit se declencher la macro ?
par ailleurs tu souhaites bien tes commentaires dans la feuille Exp+ ?
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Bonsoir,
jeromeN95 à dit:
Il fonctionne d'une maniere plus "simple" sous forme de module et un simple appel de fonction call Bulle.
Cliquez pour agrandir...
Oui tu as raison, c'est plus simple puisqu'il faut appuyer sur un bouton et passer en revue toutes les cellules 🙄
Je te rappelle ma petite recommandation---> mets de l'ordre ! il n'est même pas possible de créer des listes, en l'occurence je ne vois pas le rapport entre Chimie et...sac !
A bon entendeur...
kjin
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

oui, c 'est pas faux.
En faite, les commentaires sont bien placé et je les déclenchent sur :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'commentaire dans chaque cellule onglet Exp+ avec régles RExp+
Call bulle

Ils sont trés bien renseigné.
Par contre j'en ai un peu trop...
Aprés "bulle" j'ai sur ma feuille "Exp+" toute la colonne C qui est innondé de commentaire en fonction du produit.

Je souhaiterai uniquement retrouver ce commentaire en C16:C21 et éventuellement en C24:K24.


J'ai modifier un peu le code en y rajoutant au début de quoi supprimer les commentaires précédents si il y en avait :

Code: 
Sub bulle()
'effacer les commentaires avant
    Range("C16:E21").Select
    Selection.ClearComments
    Range("H16:H21").Select
    Selection.ClearComments
    Range("C24:L24").Select
    Selection.ClearComments
    Range("H16").Select
    
    
For n = 16 To Sheets("Exp+").Range("C65536").End(xlUp).Row
 If Sheets("Exp+").Range("C" & n) <> "" Then
  Set c = Sheets("RExp+").Columns("AE").Find(Sheets("Exp+").Range("C" & n), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    For m = numcol("AJ") To numcol("AX")
      If Sheets("RExp+").Cells(c.Row, m) <> 0 Then
        If Sheets("RExp+").Cells(c.Row, m) = "X" Then
          letexte = letexte & Sheets("RExp+").Cells(1, m) & Chr(10)
        Else
          letexte = letexte & Sheets("RExp+").Cells(1, m) & ": " & Sheets("RExp+").Cells(c.Row, m) & Chr(10)
        End If
      End If
    Next m
      On Error Resume Next
        Sheets("Exp+").Range("C" & n).Comment.Delete
        Sheets("Exp+").Range("H" & n).Comment.Delete
      On Error Resume Next
      Sheets("Exp+").Range("C" & n).AddComment letexte
      Sheets("Exp+").Range("H" & n).AddComment letexte
      Sheets("Exp+").Range("C" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("H" & n).Comment.Shape.TextFrame.AutoSize = True
      letexte = ""
      
For Each i In ActiveSheet.Comments
i.Shape.OLEFormat.Object.Font.Size = 12 'taille commentaire de toute la feuille
Next i

 End If
 End If

Next n
End Sub
Function numcol(lettrecol)
numcol = Range(lettrecol & "1").Column
End Function


Merci beaucoup.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

J'ai essayer comme ceci :
Code: 
Sub bulle()
'effacer les commentaires avant
    Range("C16:E21").Select
    Selection.ClearComments
    Range("H16:H21").Select
    Selection.ClearComments
    Range("C24:L24").Select
    Selection.ClearComments
    Range("H16").Select
For n = 16 To 24 ' To Sheets("Exp+").Range("C65536").End(xlUp).Row
 If Sheets("Exp+").Range("C" & n) <> "" Then
  Set c = Sheets("RExp+").Columns("AE").Find(Sheets("Exp+").Range("C" & n), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    For m = numcol("AJ") To numcol("AX")
      If Sheets("RExp+").Cells(c.Row, m) <> 0 Then
        If Sheets("RExp+").Cells(c.Row, m) = "X" Then
          letexte = letexte & Sheets("RExp+").Cells(1, m) & Chr(10)
        Else
          letexte = letexte & Sheets("RExp+").Cells(1, m) & ": " & Sheets("RExp+").Cells(c.Row, m) & Chr(10)
        End If
      End If
    Next m
      On Error Resume Next
        Sheets("Exp+").Range("C" & n).Comment.Delete
        Sheets("Exp+").Range("E" & n).Comment.Delete
        Sheets("Exp+").Range("F" & n).Comment.Delete
        Sheets("Exp+").Range("H" & n).Comment.Delete
        Sheets("Exp+").Range("I" & n).Comment.Delete
        Sheets("Exp+").Range("K" & n).Comment.Delete
      On Error Resume Next
      Sheets("Exp+").Range("C" & n).AddComment letexte
      Sheets("Exp+").Range("E" & n).AddComment letexte
      Sheets("Exp+").Range("F" & n).AddComment letexte
      Sheets("Exp+").Range("H" & n).AddComment letexte
      Sheets("Exp+").Range("I" & n).AddComment letexte
      Sheets("Exp+").Range("K" & n).AddComment letexte
      
      Sheets("Exp+").Range("C" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("E" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("F" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("H" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("I" & n).Comment.Shape.TextFrame.AutoSize = True
      Sheets("Exp+").Range("K" & n).Comment.Shape.TextFrame.AutoSize = True
      letexte = ""
For Each i In ActiveSheet.Comments
i.Shape.OLEFormat.Object.Font.Size = 12 'taille commentaire de toute la feuille
Next i
 End If
 End If
Next n
End Sub
Function numcol(lettrecol)
numcol = Range(lettrecol & "1").Column
End Function

Mais pareil, ça me colle des commentaires partout et pas bon en plus de ça.
Non, je n'arrive pas a tout comprendre...
 
Vote positif 0 Vote négatif
Re : INFO bulle et commentaire

Bonjour à tous,

pour que ton code s'exécute sur 1 ou plusieurs plages de cellules :
Code: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C16:C21,C24:K24")) Is Nothing Then
    Call bulle
End If
End Sub

bonne journée
@+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Question Question
Insérer commentaire ou info-bulle dont le contenu est sur une autre feuille
Réponses
8
Affichages
8 K
Dominique
D
briga
  • Question Question
Macro avec requete web puis coller dans une info bulle ou commentaire
Réponses
0
Affichages
952
briga
briga
iStarOSX
  • Question Question
boucle pour numéroter ligne si elle contien des infos et commencer num depuis une val
Réponses
9
Affichages
2 K
iStarOSX
iStarOSX
N
  • Question Question
Info bulle
Réponses
7
Affichages
6 K
Nico
N
Retour