XL 2010 Compter le nombre d'items des listes de plusieurs ComboBox

[Magic_Doctor]

Bonjour,

Sur ma feuille il y a plusieurs ComboBox nommés ("ComboListe1" à "ComboLite7"). Ces ComboBox peuvent être présents ou pas sur la feuille. Au minimum il y en a 1 et au maximum 7.
Je voudrais (pour des vérifications dans la procédure) faire le décompte des items des listes des ComboBox présents sur la feuille.
J’ai tenté de m’y prendre ainsi :

Sub NbItemsCombo()

    Dim i As Byte, cbb As MSForms.ComboBox, ListeNbItems()

    ReDim ListeNbItems(1 To NbSolvants + 1)

    For i = 1 To NbSolvants + 1
        Set cbb = ActiveSheet.OLEObjects("ComboListe" & i).Object
        ListeNbItems(i) = cbb.ListCount
    Next
   
    [G7:G13] = ""
    [G7].Resize(UBound(ListeNbItems) + 1) = Application.Transpose(ListeNbItems)
End Sub

Lamentable échec. Comment s'y prendre ?

 

[ChTi160]

Bonjour Magic_Doctor
C'est quoi le problème ,message d'erreur ,quoi ?????
Un petit fichier peut être ? Ca pourrait aider lol
Jean marie
Depuis mon téléphone

 

[job75]

Bonjour Magic_Doctor, ChTi160,

Puisqu'il y a 7 ComboBox au maximum :

Sub NbItemsCombo()
    Dim i As Byte, cbb As Object, ListeNbItems(1 To 7)

    On Error Resume Next
    For i = 1 To 7
        Set cbb = Nothing 'RAZ
        Set cbb = ActiveSheet.OLEObjects("ComboListe" & i).Object
        ListeNbItems(i) = cbb.ListCount
    Next
  
    [G7:G13] = Application.Transpose(ListeNbItems)
End Sub

A+

 

[Magic_Doctor]

Bonjour ChTi160, job,

Merci pour vos réponses.
Si je n'ai joint aucun fichier, c'est parce qu'il y a pas mal de procédures pour gérer l'application, et je sais qu'il est détestable de s'y retrouver dans ce genre de fichier, surtout quand on ne l'a pas conçu.
Je viens d'essayer la solution de job, curieusement, comme avec ce que j'avais tenté, me renvoie "0" pour tous les ListCount des ComboBox.

En conséquence, je n'ai pas d'autre choix que de joindre le fichier.
La macro en question se trouve dans "Módulo2".

 

[ChTi160]

Te
Pourquoi pas un truc plus direct , du genre
ListeNbItems(i)=ActiveSheet.OLEObjects("ComboListe" & i).Object.ListCount
Bonne fin de journée
Jean marie
de mon téléphone

 

[job75]

Je viens d'essayer la solution de job, curieusement, comme avec ce que j'avais tenté, me renvoie "0" pour tous les ListCount des ComboBox.

La macro renvoie de zéros en G7:G13 car les listes des 7 ComboBox sont vides au départ.

Clique dans les 5 ComboBox visibles pour remplir leurs listes (26 items) et relance la macro.

@ChTi160 oui la variable cbb n'est pas nécessaire ici mais ça n'a pas grande importance.

Elle est quand même intéressante pour montrer qu'il faut dans la boucle l'initialiser à Nothing.

 

[ChTi160]

Re
Effectivement !
merci job75
jean marie

 

[Magic_Doctor]

Re,

Ça marche pour les 2 procédures. Il fallait donc juste cliquer sur chacun des ComboBox. Mais ne pourrait-on pas automatiser cette "corvée" ?

 

[Magic_Doctor]

Problème réglé.
cbb.Activate.

 

[ChTi160]

Re
ou alors tu peux peut être , récupérer les données des la procédure Workbook_Open , là où tu charges les Combobox .
voir ce que j'ai ajouté dans cette procédure !

Sub Workbook_Open()
'Magic_Doctor
Erase ListeNbItems
    Dim i As Byte, limite As Byte, liste(), h!, cbb As MSForms.ComboBox
Dim x As Byte
    NbSolvants = [RememberNbSolvants]                      'cellule "virtuelle" qui conserve la dernière valeur entrée dans le ComboBox "ComboBox_NbSolvants_Change" avant fermeture du classeur
    NbComboListe = NbActiveX("ComboBox", "ComboListe", 1)  'nombre de ComboBox dans la "feuille 1" ("Données") dont le préfixe est "ComboListe"
'*************************************
 ReDim Preserve ListeNbItems(NbSolvants + 1)
'*************************************
    Sheets("Données").Select  'au cas où l'on était dans la feuille "BD" lors de la fermeture du classeur, sinon bordel incommensurable à l'ouverture du classeur
   
    'Hauteur entre les sommets de 2 ComboBox qui se superposent
    Set cbb = ActiveSheet.OLEObjects("ComboListe1").Object  'ComboBox "ComboListe1"
    TopToTop = cbb.Height                                   'hauteur du ComboBox
    TopToTop = TopToTop + espacement                        'hauteur entre les sommets de 2 ComboBox superposés
   
    '*********************** Positionnement, par rapport au haut de la feuille, du 1er ComboBox ***********************
    'Hauteur de l'ensemble des lignes allant du haut de la feuille jusqu'à la ligne nommée "LigneExpansible" (exclue)
    limite = [LigneExpansible].Row           'numéro de ligne de la ligne nommée "LigneExpansible"
    For i = 1 To limite - 1                  'toutes les lignes depuis le haut de la feuille jusqu'à la ligne "LigneExpansible"
        h = Rows(i).RowHeight                'hauteur de chaque ligne
        TopComboListe1 = TopComboListe1 + h  'hauteurs cumulées
    Next
    ActiveSheet.Shapes("ComboListe1").Top = TopComboListe1  'positionnement du 1er ComboBox par rapport au haut de la feuille
    'Chargement du ComboBox "ComboBox_NbSolvants" (nombre de solvants désirés pour la formulation)
    ReDim liste(1 To NbComboListe)
    For i = 1 To NbComboListe
        liste(i) = i  'il y a autant d'items que de ComboBox qui auront été crées
    Next
    With Worksheets("Données").ComboBox_NbSolvants
        .List = Application.Transpose(liste)
        .ListIndex = NbSolvants
    End With
    'Chargement du tableau dynamique "ListeSolvChoisis()" (liste des solvants choisis avant la fermeture du classeur)
    For i = 1 To NbSolvants + 1
        Set cbb = ActiveSheet.OLEObjects("ComboListe" & i).Object
        ListeSolvChoisis(i) = cbb.Value
'*************************************
        ListeNbItems(i) = ActiveSheet.OLEObjects("ComboListe" & i).Object.ListCount 'on charge le Nombre de lignes
'*************************************
    Next
'*************************************
      [G7:G13].ClearContents 'on efface la plage de données
      [G7:G13] = ListeNbItems
'*************************************
End Sub

Bonne nuit
jean marie

 

[job75]

Problème réglé.
cbb.Activate.

Bah avec le code du post #3 ça ne fonctionne pas, il faut modifier cbb :

    For i = 1 To 7
        Set cbb = Nothing 'RAZ
        Set cbb = ActiveSheet.OLEObjects("ComboListe" & i)
        cbb.Activate
        ListeNbItems(i) = cbb.Object.ListCount
    Next

ou aussi :

    For i = 1 To 7
        With ActiveSheet.OLEObjects("ComboListe" & i)
            .Activate
            ListeNbItems(i) = .Object.ListCount
        End With
    Next

 

[job75]

De plus on peut constater que ComboList6 et ComboList7 sont masquées et superposées...