Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Decocher des cases avec une macro

cgrandmaire

XLDnaute Nouveau
bonjour
J'ai fait un tableau où on coche des cases.Je souhaiterai faire une macro pour re-innitialiser mon tableau, donc décocher toutes les cases.
Merci
 

geraldine69

XLDnaute Nouveau
Re : Decocher des cases avec une macro

Bonjour,

Cela dépend de la provenance des cases à cocher.

Voici une méthode pour 3 vas de figure


Mettre à zéro toutes les cases à cocher sur Un UseForm

Private Sub CommandButton1_Click()

Dim InitCase As Control
For Each InitCase In Me.Controls
InitCase.Value = False
Next InitCase

End Sub


Mettre toutes les cases à cocher sur une feuille Excel

Si les cases à cocher proviennent de la barre outil Contrôle


Sub InitCaseACocher()
Dim Shps As OLEObject
For Each Shps In Feuil1.OLEObjects
If Shps.progID = "Forms.CheckBox.1" Then
Shps.Object.Value = False
End If
Next Shps
End Sub


Si les cases à cocher proviennent de la barre outil Formulaire

Sub InitCaseACocher()
Dim Shp As Shape
For Each Shp In Sheets("Feuil1").Shapes
If Shp.Name Like "Check Box*" Then
Shp.DrawingObject.Value = False
End If
Next Shp
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Decocher des cases avec une macro

Bonjour à tous

Peut aussi fonctionner selon le contexte ( ici case à cocher issue de Formulaire)
(juste histoire de s'épargner de boucler)
Code:
sub decoche()
ActiveSheet.DrawingObjects = False
end sub
 

Staple1600

XLDnaute Barbatruc
Re : Decocher des cases avec une macro

Re

cgrandmaire
Si tu dissocies ton groupe, cela fonctionne (Tu sélectionnes ton groupe, clic-droit puis choisir Dissocier, avant d’exécuter la macro)
(j'ai testé avec ma macro et cela fonctionne)

Edition: bonjour CB60, penses-tu qu'on soit obliger de boucler dans le cas présent ?
 
Dernière édition:

CB60

XLDnaute Barbatruc
Re : Decocher des cases avec une macro

re
test cela:

edit
bonjour Stapple, non la boucle n'est pas necessaire.
la macro devient:
HTML:
Sub decoche()
On Error Resume Next
ActiveSheet.Shapes(1).Select
Selection.ShapeRange.Ungroup.Select
ActiveSheet.DrawingObjects = False
ActiveSheet.Shapes("Picture 40").Select
Selection.ShapeRange.Regroup.Select
Range("A1").Activate
End Sub
 
Dernière édition:

Discussions similaires

  • Résolu(e)
Microsoft 365 kutools
Réponses
28
Affichages
380
Réponses
5
Affichages
385
Réponses
3
Affichages
378
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…