Effacer des coches

[thomasdu43]

Bonjour,

Le fichier joint est composé de cellules à renseigner et de coches. Je souhaiterai en plus de l'effacement des cellules, par action sur le bouton dédié, que les coches soient "remises à zéro".

Pouvez vous m'aider ?

Merci.

Cdt.

 

[jpb388]

Re : Effacer des coches

Bonjour à tous
tu remplaces par celle ci

Sub Effacer_cellules_recueil()
'
' Effacer_cellules_recueil Macro
    Dim Ctl As Shape
    Application.EnableEvents = False
    With Worksheets("Recueil besoins")
        .Range( _
            "B2:D2,F2:I2,B4:J4,B5:J5,B6:D6,F6:I6,B8:D10,F8:J10,C13:D17,E15:J17,E22:J22,E33:J33,I21,B45:C45,F96:J102,G106:J108,A110:J115,F118:J118,B120:C120,F120" _
            ).ClearContents
        For Each Ctl In .Shapes
            If Left(Ctl.Name, 9) = "Check Box" Then .Shapes(Ctl.Name).OLEFormat.Object.Value = 0
        Next Ctl
    End With
Application.EnableEvents = True
End Sub

 

[thomasdu43]

Re : Effacer des coches

Bonjour,

Merci de ce retout mais il semble qu'il ya ait un pb sur la ligne .Range( _"noms des cellules"_ ).ClearContents

Avez vous une solution ?

Merci.

 

[jpb388]

Re : Effacer des coches

Bonsoir à tous

Regarde si cela te va

Sub Effacer_cellules_recueil()
'
' Effacer_cellules_recueil Macro
    Dim Ctl As Shape
    Application.EnableEvents = False
    With Worksheets("Recueil besoins")
    Range( _
       "B2:D2,F2:J2, B4:J5,B6:D6,F6:J6,B8:D10,F8:J10,C13:D15,C16:D17,E15:G17,H15:J17,E22:J22,B45:C45,F45:J45,G51:G83,H51:J83,B85:C85," _
       & "F85:J85,B88:D88,F88:J88,B90:J91,B92:D92,F92:J92,F96:J102,G106:J108,A110:J115,F118:J118,B120:C120,F120:J120").ClearContents
        For Each Ctl In .Shapes
            If Left(Ctl.Name, 9) = "Check Box" Then .Shapes(Ctl.Name).OLEFormat.Object.Value = 0
        Next Ctl
    End With
Application.EnableEvents = True
End Sub

 

[thomasdu43]

Re : Effacer des coches

Super ça fonctionne, merci.

 

[thomasdu43]

Re : Effacer des coches

J'ai été un peu trop rapide dans mes remerciements. En fait cela fonctionne dès lors que la feuille n'est pas protégée. Si je la protège, j'ai un message d'erreur. Comment se fait-il ?

 

[jpb388]

Re : Effacer des coches

re
copie et colle cette macro dans le thisworkbook

Private Sub Workbook_Open()
 Worksheets("Recueil besoins").Protect userinterfaceonly:=True
End Sub

clic dessus, fait F5 et teste

 

[thomasdu43]

Re : Effacer des coches

Bonjour,
Cela fonctionne mais ôte la protection de la feuille sans mot de passe lorsqu'on clique sur "Oter la protection".
Existe-il un moyen de remédie à cela ?
Merci.

 

[jpb388]

Re : Effacer des coches

Bonsoir à tous
essaye

Private Sub Workbook_Open()
 Worksheets("Recueil besoins").Protect Password:="Toto", userinterfaceonly:=True
End Sub

 

[thomasdu43]

Re : Effacer des coches

Merci beaucoup !!