tester l'existence d'un check box sur une feuille

[jhofman]

Bonjour,


je dois traiter les réponse à une enquête.
les formulaire sont des feuilles excel comportant des check box !
il y a eu des renomage inexpliqué de ces check box.

Comment puis-je tester l'exitence d'une série de check box ou radio bouton ?

actuellement sur ma feuille je teste ainsi
ActiveSheet.Shapes("Check Box 77").Select
If Selection.Value = 1 Then (...)

avec un premier renvoie en cas d'erreur :
On Error GoTo autre_question.

mais comment tester plusieurs cas dans la même code.

Merci

 

[tototiti2008]

Re : tester l'existence d'un check box sur une feuille

Bonjour jhofman,

si tu veux les noms de tous les shapes :

Sub ListeShapes()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.Name
Next
End Sub

si tu veux seulement les checkbox :

Sub ListeCheckbox()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
if Sh.Name Like "Check Box*" then
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.Name
end if
Next
End Sub

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

Merci du coup de main.
José

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

précision : j'ai des check box qui ont été regroupés dans des groupes.
la procédure ne semble restituer que les groupes.

Group 1
Group 5
Group 97
Group 13
Group 17
Group 98
Group 91
Group 41
Group 47(...)

 

[tototiti2008]

Re : tester l'existence d'un check box sur une feuille

tu les a créés avec la barre d'outils formulaire ou la boite à outils contrôles ?

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

ils ont malheuresement été créés avec la boite à outils contrôle puis regroupés...

 

[tototiti2008]

Re : tester l'existence d'un check box sur une feuille

essaye peut-être ça :

Sub ListeOLE()
Dim Sh As OLEObject
For Each Sh In ActiveSheet.OLEObjects
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.Name
Next
End Sub

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

je teste cela dès lundi.
a+

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

j'ai fait le test

ListeOLE ne retourne rien.
ListeShapes me donne bien les Check Box .... si j'ai pris la précaution de les dégrouper .
Ils ont été créé puis regroupé.
il faudrait donc que quand je rencontre un groupe j'excécute automatiquement un dégroupage avant de pouvoir à nouveau examiner la procédure... ce que j'ai écris ci-dessous mais qui ne marche pas complément

ci-joint un excemple de fichier avec des groupes et des check box dont j'amerais faier l'inventaire

Sub ListeCheckbox()
' suppression de group pour avoir une visibilité sur les check box
'
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
If Sh.Name Like "Group*" Then
    Sh.Select
    Selection.ShapeRange.Ungroup.Select
    
    
End If
Next
' liste des check box
For Each Sh In ActiveSheet.Shapes
If Sh.Name Like "Check Box*" Then
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.Name
End If
Next
End Sub

 

[tototiti2008]

Re : tester l'existence d'un check box sur une feuille

Bonjour jhofman,

les contrôles de ton fichier n'ont pas été faits avec la boite à outils contrôles mais avec la barre d'outils Formulaire (pour info)

voilà le code que j'allais te proposer mais il semble que tu ai trouvé tout seul :

Sub ListeShapes()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
    If Sh.Name Like "Group*" And Not Sh.Name Like "Group Box*" Then
        Sh.Ungroup
    End If
Next
For Each Sh In ActiveSheet.Shapes
    ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.Name
Next
End Sub

 

[STephane]

Re : tester l'existence d'un check box sur une feuille

de l'eau à ton moulin

Sub DEMO()
Dim sh As Shape, gpi As Shape
For Each sh In ActiveSheet.Shapes
    
    'si c'est un grope
    If sh.Type = 6 Then 'Type de forme "msoGroup" (6° type MsoShapeType)
        For Each gpi In sh.GroupItems
            If gpi.Type = msoOLEControlObject Then 'utiliser msoFormControl pour les objets de la abrre formulaire
                If gpi.DrawingObject.progID = "Forms.CheckBox.1" Then 'tester la propriété FormControlType pour les objets de la abrre formulaire
                    'Stop    'passer en mode déboguage
                    Call FormControl_Checkbox_demo
                End If
            End If
            ' pour certaines actions sur un objet du gorupe, il faudra peut-être dégrouper puis regrouper
            ' SH.Ungroup: gpi.Delete:
            ' On Error Resume Next
            ' Selection.ShapeRange.Regroup.Select
        Next gpi
    Else
    'si ce n'est pas un groupe
    End If
Next sh
End Sub

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

Bonjour,


la procédure de tototiti2008 me convient parfaitement.
.. bien que la prcédure de STephane semble moins destructrice ... mais nécessite un plus gros effort d'adaptation.

Est-il possible d'extraire toutes les valeur des Option Button dans la même procédure ?
Merci

 

[tototiti2008]

Re : tester l'existence d'un check box sur une feuille

Bonjour Stéphane, trés intéressant.

jhofmann, voici un code qui écrit les valeurs des Option Button et des CheckBox dans la colonne B

Sub ListeShapes()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
    If Sh.Name Like "Group*" And Not Sh.Name Like "Group Box*" Then
        Sh.Ungroup
    End If
Next
For Each Sh In ActiveSheet.Shapes
    derligne = ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Row
    ActiveSheet.Range("A" & derligne).Value = Sh.Name
    If Sh.Name Like "Check*" Or Sh.Name Like "Option*" Then ActiveSheet.Range("B" & derligne).Value = Sh.ControlFormat.Value
Next
End Sub

 

[jhofman]

Re : tester l'existence d'un check box sur une feuille

Merci à tous et particulièrement tititoto2008
... entre temps j'avais finis par trouver une méthode de restituer les cellule concernées (TopLeftCell.Address) et el texte de la check box (AlternativeText).

encore merci

Sub ListeShapes()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes
    If Sh.Name Like "Group*" And Not Sh.Name Like "Group Box*" Then
        Sh.Ungroup
    End If
Next
For Each Sh In ActiveSheet.Shapes
    If Not Sh.Name Like "Group*" Then
       Sh.Select
        ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0).Value = Sh.TopLeftCell.Address
        ActiveSheet.Range("A65536").End(xlUp).Offset(0, 2).Value = Sh.Name
        ActiveSheet.Range("A65536").End(xlUp).Offset(0, 3).Value = Selection.Value
        ActiveSheet.Range("A65536").End(xlUp).Offset(0, 4).Value = Sh.AlternativeText
    
    End If
    
Next
End Sub