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

Proflatzer

XLDnaute Nouveau
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.
 

Pièces jointes

  • progression seconde msec V4.xlsm
    103.4 KB · Affichages: 42

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonsoir,

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

JB
 

Pièces jointes

  • Copie de progression seconde msec V4-1.xls
    255 KB · Affichages: 59
  • Copie de progression seconde msec V4-2.xls
    260 KB · Affichages: 40
Dernière édition:

Proflatzer

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Copie de progression seconde msec V4-4.xls
    256.5 KB · Affichages: 24
  • Copie de progression seconde msec V4-3.xls
    273 KB · Affichages: 30
Dernière édition:

Noel Bedard

XLDnaute Occasionnel
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
 

Pièces jointes

  • Copie de progression seconde msec V4-4.xlsm
    108.4 KB · Affichages: 25
Dernière édition:

Proflatzer

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Copie de progression seconde msec V4-5.xls
    277 KB · Affichages: 25

Proflatzer

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Copie de progression seconde msec V4-6.xls
    276.5 KB · Affichages: 30
  • Copie de progression seconde msec V4-7.xls
    274.5 KB · Affichages: 29
Dernière édition:

Proflatzer

XLDnaute Nouveau
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

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • Copie de progression seconde msec V4-6.xls
    275 KB · Affichages: 48
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 185
Messages
2 086 014
Membres
103 093
dernier inscrit
Molinari