Info bulle pour chaque choix d'un menu déroulant

Proflatzer · 10 Février 2018

Salut à tous,

Après avoir été aidé pour une macro de "mutualisation/regroupement" de ligne (encore merci à Noel Bedard), je reviens vers une âme charitable pour m'aider encore une fois.

Voilà, je souhaiterai avoir une "info bulle/message" qui me donne de contenu du choix possible dans mon menu déroulant; ce contenu apparaît après dans le cellule à coté de mon menu déroulant uniquement après l'avoir sélectionné; je voudrais qu'il apparaisse avec la sélection au passage de la souris sur le choix possible.

Merci encore pour votre aide.

Cordialement Proflatzer.

BOISGONTIER · 10 Février 2018

Bonsoir,

Remplacer Données/Validation par un comboBox à 2 colonnes ou une bulle au survol des options?

JB

Proflatzer · 10 Février 2018

Salut Boisgontier,

Excellent, c'est ce que je cherchais, mais y a t'il toujours un corrélation entre mais cellule taches, compétences et savoirs avec grâce au information de l'onglet DATA.
Pourriez-vous me dire comment mettre les informations de la combobox à la ligne pour avoir toute les donnée nécessaire et comment mettre en place un combobox dans les autres cellules compétences et savoirs.

En tout cas merci beaucoup.

Cordialement Proflatzer.

BOISGONTIER · 11 Février 2018

Bonjour,

Code:

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Ligne = Int(Y / (ComboBox1.Font.Size * 1.22))
  If Ligne < Me.ComboBox1.ListCount Then
    On Error Resume Next
    Me.TextBox1 = ComboBox1.List(Ligne + Me.ComboBox1.TopIndex, 1)
  End If
End Sub

Private Sub ComboBox1_click()
  ActiveCell = Me.ComboBox1
  Unload Me
End Sub

JB

Noel Bedard · 11 Février 2018

Bonjour Proflatzer,

Je me suis permis d'ajouter quelques lignes dans votre routine Compléter, l'écran scintillait beaucoup trop.
Rien à avoir pour votre dernière requête.

Code:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
;
;
;
;
Feuil4.Select
Range("A5").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Bonjour
Noël

Proflatzer · 11 Février 2018

Bonjour Noël,

Merci pour cette amélioration, effectivement cela évite le scintillement de l'écran qu passe d'onglet en onglet...
J'ai fait un ou deux test avant de comprendre comment l'utiliser et qu'il fallait mettre le routine "compléter" tout entière à la place de point virgule, mais ça fonctionne.

Encore merci pour ça.

Cordialement Proflatzer.

Proflatzer · 11 Février 2018

Bonjour JB,

Encore merci pour votre investissement.

Pour ne rien vous cachez et j'espère ne pas vous démotivez je préfère la modification de la version V4-2 qui est beaucoup plus lisible (en tout cas pour moi)
Sinon pour le version V4-4 mise en forme sur les cellules A,C et E est ce que je voulais, malgré tout il n'y a plus de système en cascade comme pour la solution Données/Validation qui me permettait de n'avoir pour la "tache 11" que les possibilité de "compétences xxx" définie dans la colonne J de l'onglet DATA et ainsi de suite pour les autres taches en corrélation avec les compétences; tout comme les différentes compétences avec les savoir.... pour ce faire j'avais utilisé la fonction INDIRECT() pour avoir un effet cascade de possibilité limité.

Encore merci à vous pour ce super travail et le temps passé pour m'aider.

Cordialement Proflatzer.

BOISGONTIER · 11 Février 2018

Je n'avais pas vu qu'il s'agissait de listes en cascade.
(Il doit être possible de faire la même chose sans tous ces champs nommés)

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("data")
  If Not Intersect(Range("A2:A1000"), Target) Is Nothing And Target.Count = 1 Then
    UserForm1.ComboBox1.List = f.Range("A3:B" & f.[A65000].End(xlUp).Row).Value
    UserForm1.Show
  End If
  '-- niveau 2
  If Not Intersect(Range("C2:C1000"), Target) Is Nothing And Target.Count = 1 Then
    Tbl2 = f.Range("D3:E" & f.[D65000].End(xlUp).Row).Value
    nom = Target.Offset(, -2)
    n = f.Range(nom).Count
    Tbl1 = f.Range(nom).Value
    ReDim Tbl(1 To n, 1 To 2)
    For i = 1 To n
      For j = 1 To UBound(Tbl2)
        If Tbl1(i, 1) = Tbl2(j, 1) Then Tbl(i, 1) = Tbl2(j, 1): Tbl(i, 2) = Tbl2(j, 2)
      Next j
    Next i
    UserForm1.ComboBox1.List = Tbl
    UserForm1.Show
  End If
  '--niveau 3
  If Not Intersect(Range("E2:E1000"), Target) Is Nothing And Target.Count = 1 Then
     Tbl2 = f.Range("G3:H" & f.[G65000].End(xlUp).Row).Value
     nom = Target.Offset(, -2)
     n = f.Range(nom).Count
     Tbl1 = f.Range(nom).Value
     ReDim Tbl(1 To n, 1 To 2)
     For i = 1 To n
       For j = 1 To UBound(Tbl2)
        If Tbl1(i, 1) = Tbl2(j, 1) Then Tbl(i, 1) = Tbl2(j, 1): Tbl(i, 2) = Tbl2(j, 2)
       Next j
    Next i
    UserForm1.ComboBox1.List = Tbl
    UserForm1.Show
  End If
End Sub

JB

Proflatzer · 11 Février 2018

JB

Super géniale (j'y comprend rien "ou pas loin" à tout ce code mais c'est tout simplement parfais)

La version V5-5 est la bonne.

Oui c'est surement possible sans tous les champs nommés malheureusement ce n'est pas dans mon domaine de compétence en tout cas merci encore pour ce super boulot.

Je vais transformer les autres fichiers qui sont sur la même base (forme) des autres classes pour avoir le même résultat.

Encore un grand merci à tous les deux.

Mes collègues qui ont des difficultés avec la manipulation des référentiels de classe vont pouvoir tenté d’établir des progressions avec je l'espère un peu plus de facilité.

Cordialement Proflatzer.

BOISGONTIER · 11 Février 2018

Version sans les noms de champ (bulle & ComboBox 2 Colonnes)

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("data")
  If Not Intersect(Range("A2:A1000"), Target) Is Nothing And Target.Count = 1 Then
    UserForm1.ComboBox1.List = f.Range("A3:B" & f.[A65000].End(xlUp).Row).Value
    UserForm1.Show
  End If
  '-- niveau 2
  If Not Intersect(Range("C2:C1000"), Target) Is Nothing And Target.Count = 1 Then
    Tbl2 = f.Range("D3:E" & f.[D65000].End(xlUp).Row).Value
    nom = Target.Offset(, -2)
    Set DebutCompetences = f.[ListeTaches].Find(nom).Offset(1)
    Set finCompetences = DebutCompetences.End(xlDown)
    Set champcompetences = DebutCompetences.Resize(finCompetences.Row - 3)
    n = champcompetences.Count
    Tbl1 = champcompetences.Value
    ReDim Tbl(1 To n, 1 To 2)
    For i = 1 To n
      For j = 1 To UBound(Tbl2)
        If Tbl1(i, 1) = Tbl2(j, 1) Then Tbl(i, 1) = Tbl2(j, 1): Tbl(i, 2) = Tbl2(j, 2)
      Next j
    Next i
    UserForm1.ComboBox1.List = Tbl
    UserForm1.Show
  End If
  '--niveau 3
  If Not Intersect(Range("E2:E1000"), Target) Is Nothing And Target.Count = 1 Then
     Tbl2 = f.Range("G3:H" & f.[G65000].End(xlUp).Row).Value
     nom = Target.Offset(, -2)
     Set DebutSavoirs = f.[ListeCompetences].Find(nom).Offset(1)
     Set finSavoirs = DebutSavoirs.End(xlDown)
     Set champSavoirs = DebutSavoirs.Resize(finSavoirs.Row - 3)
     n = champSavoirs.Count
     Tbl1 = champSavoirs.Value
     ReDim Tbl(1 To n, 1 To 2)
     For i = 1 To n
       For j = 1 To UBound(Tbl2)
        If Tbl1(i, 1) = Tbl2(j, 1) Then Tbl(i, 1) = Tbl2(j, 1): Tbl(i, 2) = Tbl2(j, 2)
       Next j
    Next i
    UserForm1.ComboBox1.List = Tbl
    UserForm1.Show
  End If
End Sub

JB

Proflatzer · 11 Février 2018

Là je dit encore un super boulot.

Merci encore pour le travail. Je fait l'update sur les autres fichiers avec la mise en forme de la version V4-6 sans les champs nommés.

Encore bravo, rapide et super efficace.

Cordialement Proflatzer

Proflatzer · 11 Février 2018

Heu désole de revenir, j'ai une autre question.

Y a t'il un moyen d'avoir le texte de la définition et du choix un peu plus grand car mes collègue "ne sont plus de première jeunesse" et quand il regarde les tableaux généralement c'est la demande qui ressort très fréquemment.

Par avance merci.

Cordialement Proflatzer.

BOISGONTIER · 11 Février 2018

Dans le formulaire, j'ai mis la taille de la police à 8 (propriété Font). Elle peut être agrandie.
Pour exporter un formulaire et l'importer dans un autre classeur: clic-droit sur le formulaire/Exporter.

http://boisgontierjacques.free.fr/fichiers/Formulaire/ComboBoxBulleListesCascades.xls

Code:

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Ligne = Int(Y / (ComboBox1.Font.Size * 1.19))
  If Ligne < Me.ComboBox1.ListCount Then
    On Error Resume Next
    Me.TextBox1 = ComboBox1.List(Ligne + Me.ComboBox1.TopIndex, 1)
  End If
End Sub

Private Sub ComboBox1_click()
  ActiveCell = Me.ComboBox1
  Unload Me
End Sub

JB

Proflatzer · 12 Février 2018

Ok effectivement je viens de voir ou était l'information et j'ai réussi à faire le changement.

Encore merci.

Cordialement Proflatzer.

BOISGONTIER · 14 Février 2018

Bonjour,

On peut ajouter de la couleur sur la bulle

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormBulleComboCouleur.xls

JB

Info bulle pour chaque choix d'un menu déroulant

Proflatzer

XLDnaute Nouveau

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Proflatzer

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Noel Bedard

XLDnaute Occasionnel

Pièces jointes

Proflatzer

XLDnaute Nouveau

Proflatzer

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Proflatzer

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Proflatzer

XLDnaute Nouveau

Proflatzer

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

Proflatzer

XLDnaute Nouveau

BOISGONTIER

XLDnaute Barbatruc

Discussions similaires

Info bulle pour chaque choix d'un menu déroulant

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency