XL 2019 Checkbox

[momo2394]

Bonjour le forum Voilà mon souci, j'ai des checkbox et je voudrais une macro que si l'une des checkbox n'est pas coché, alors je ne peux enregistrer

et qu'elle me montre ou est la ou les checkbox(s) n'ont coché Merci

 

[patricktoulon]

bonjour
puré encore un
question que tu dois te poser
alors a quoi ca sert que tu ai des oui/non (c'est incohérent avec la demande )
enlève en un par ligne
si coché c'est oui sinon c'est non et basta

 

[momo2394]

Eh! du calme je ne suis pas agressif avec toi et je ne t'ai pas mis un couteau sur la gorge alors soit un peu plus poli et surtout quald on ne sait pas on se tait et non faire des reflexions d'un gamin attardé

 

[laurent3372]

J'ai un peu arrangé ta feuille.
Voici la macro:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim lig As Long
    Dim rng As Range
    Dim err As Boolean
    err = False
    For lig = 2 To 4
        Set rng = Cells(lig, "G").Resize(, 3)
        rng.Interior.Color = RGB(255, 255, 255) ' Fond blanc
        If Not Cells(lig, "O").Value Then
            rng.Interior.Color = RGB(255, 0, 0) 'Si erreur, fond rouge
            err = True
        End If
    Next lig
    If err Then
        MsgBox "Cocher les cases"
        Cancel = True ' On n'enregistre pas
    End If
End Sub

 

[momo2394]

Bonsoir Laurent 3372

C'est parfait! c'est vraiment ce que je recherchais
Encore Merci

 

[laurent3372]

Tu peux marquer le fil comme résolu

 

[momo2394]

Salut le forum et Laurent3372

Je reviens vers vous pour la macro print si les checkboxs sont cochés, elle fonctionne super bien seulement les feuilles de mon classeur sont différents dans les nombres de checkboxs donc de lignes.
Comment gérer le :
For Lig = 2 to 4 pour la feuil 1
For Lig = 2 to 6 pour la feuil 2
For Lig = 2 to 8 pour la feuil 3
ou alors est il possible d'insérer un BeforePrint dans chaque Feuille.
Merci

 

[patricktoulon]

bonjour
teste cela et analyse

Sub testx()
    Dim result(1 To 3), F&, Rng, Lig&, NbLimite
    NbLimite = Array(3, 6, 8)
    For F = 1 To 3
        'result(F) = Sheets(F).Name
        For Lig = 2 To NbLimite(F - 1)
            Set Rng = Sheets(F).Cells(Lig, "G").Resize(, NbLimite(F - 1))
            Rng.Interior.Color = RGB(255, 255, 255)    ' Fond blanc
            If Not Sheets(F).Cells(Lig, "O").Value Then
                Rng.Interior.Color = RGB(255, 0, 0)    'Si erreur, fond rouge
                result(F) = Sheets(F).Name
                err = True
            End If
        Next Lig
    Next F
    If err = True Then MsgBox "les sheets a revoir sont  : " & vbCrLf & Replace(Application.Trim(Join(result, " ")), " ", vbCrLf)
End Sub

 

[laurent3372]

ou alors est il possible d'insérer un BeforePrint dans chaque Feuille.

Voir Pièce jointe

 

[momo2394]

Bonjour Laurent3372 et PatrickToulon

Merci à vous deux, cependant je garde la macro de Laurent3372
Bien joué le NBVAL
Bonne journée et Mille Merci