XL 2016 [VBA] Récupération des Checkbox cochées

tomy

XLDnaute Nouveau
Salut les Excelliens !

Je cherche un moyen d'automatiser la lecture d'un formulaire.
Il y a env. 90 Checkbox et je cherche une idée pour faire un script qui les analyserai toutes une par une et remonterai le "Name" des checksboxs cochées.

Ca parle à quelqu'un ? Comment automatiser la "lecture" de toutes les checkbox (sachant qu'elle ont toute un nom différent - pas possible d'automatiser avec le CheckBoxXX"

Merci
Thom
 

JM27

XLDnaute Barbatruc
bonjour
en changeant MonUserform par le vrai nom de ton userform
j'ai mis un message , mais tu peux faire un traitement à la place , mais sans fichier ?
VB:
 For Each Ctrl In MonUserform.Controls
        If TypeOf Ctrl Is MSForms.CheckBox Then
                msgbox.ctrl.name
                msgbox.ctrl.value
        End If
     Next
 

job75

XLDnaute Barbatruc
Bonjour tomy, JM27,

Mettez ces codes dans un module standard et exécutez les macros :
VB:
Public Tableau() 'mémorise la variable

Sub USF()
UserForm1.Show 0 'non modal (pour pouvoir exécuter les macros)
End Sub

Sub CreerTableau()
Dim c As Object, n%
Erase Tableau
For Each c In UserForm1.Controls 'adapter le nom de l'UserForm
    If TypeName(c) = "CheckBox" Then
        n = n + 1
        ReDim Preserve Tableau(1 To 2, 1 To n) 'tableau de 2 lignes et n colonnes
        Tableau(1, n) = c.Name
        Tableau(2, n) = c.Value
    End If
Next
End Sub

Sub Test()
Rows(1).ClearContents 'RAZ
On Error Resume Next
[A1].Resize(2, UBound(Tableau, 2)) = Tableau
End Sub
A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Autre solution si l'on veut uniquement lister les CheckBox cochées :
Code:
Public Tableau() 'mémorise la variable

Sub USF()
UserForm1.Show 0 'non modal (pour pouvoir exécuter les macros)
End Sub

Sub CreerTableau()
Dim c As Object, n%
Erase Tableau
For Each c In UserForm1.Controls 'adapter le nom de l'UserForm
    If TypeName(c) = "CheckBox" Then
        If c Then 'si cochée
            n = n + 1
            ReDim Preserve Tableau(1 To n) 'vecteur ligne
            Tableau(n) = c.Name
        End If
    End If
Next
Test
End Sub

Sub Test()
Columns(1).ClearContents 'RAZ
On Error Resume Next
[A1].Resize(UBound(Tableau)) = Application.Transpose(Tableau)
End Sub
 
Dernière édition:

tomy

XLDnaute Nouveau
Merci Job75 et JM. Super travail.

Seul soucis : Quelle macro dois je lancé parmis les 3 ?
J'ai donc : lancé USF et j'ai ajouté sur mon userform un bouton vers Creertableau.

Lorsque CreerTableau se lance j'ai une erreur "Redimm incorrect" (sur les deux versions du script)
 

Discussions similaires

Statistiques des forums

Discussions
311 722
Messages
2 081 930
Membres
101 843
dernier inscrit
Thaly