XL 2010 Code VBA qui bloque la sauvegarde si certaines cellules sont vides

[sebbbbb]

Bonjour a toutes et tous

j'ai trouvé une partie du code mais celui ci fonctionne seulement si une condition est remplie (c'est à dire une cellule vide bloque la sauvegarde). celà se gate pour cumuler les autres conditions (autres cellules vides)

Dans le fichier test en PJ je souhaiterai que lorsqu'une cellule de la colonne T est supérieure à 0, et si les cellules (E,F,N,M) de la même ligne sont vides, alors un message apparaisse lorsque l'utilisateur enregistre le doc pour lui signaler qu'il doit entrer les données dans ces cellules. celà pour obliger l'utilisateur a entrer toutes les données importantes du fichier

merci a vous pour votre aide

seb

 

[sylvanu]

Bonjour Seb,
Ne serait ce pas une solution d'avertir en temps réel l'utilisateur via une colonne supplémentaire ?
Voir PJ pour démo.

Sinon on peut le faire via du VBA mais ça ne fera la vérification qu'à la fin avant l'enregistrement.

 

[sylvanu]

Ou encore en temps réel, sur une ligne colore toutes les cellules vides qui devraient être remplies.

 

[sebbbbb]

bjr Sylvanu
merci pour ton aide
en fait ce que je souhaite c'est non pas informer l'utilisateur mais l'obliger a entrer toutes les données importantes, car trop de personnes enregistre le doc sans se soucier de ce qui manque ou pas

pour le VBA pas de soucis si la verif se fin qu'à la fin du moment que celà bloque l'enregistrement s'il manque des données

merci

 

[sylvanu]

En PJ un essai à tester avec :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    For L = 6 To DL - 2 ' pas d'analyse sur les deux dernières lignes
        If Val(Cells(L, "T")) > 0 Then
            If Cells(L, "E") = "" Or Cells(L, "F") = "" Or Cells(L, "M") = "" Or Cells(L, "N") = "" Then
                MsgBox "Une ou plusisurs lignes sont incomplètes." & Chr(10) & Chr(10) & _
                        "Enregistrement impossible."
                Cancel = True
                Exit Sub
            End If
        End If
    Next L
End Sub

J'ai gardé les MFC pour guider l'utilisateur, inutile qu'il cherche désespérément pourquoi il est "coincé". 🙂

 

[sebbbbb]

Celà me semble très bien
je teste et te redis

 

[sebbbbb]

Sylvanu
c'est tres bien ; merci
celà fonctionne parfaitement sur le fichier test mais je n'arrive pas a adapter le code sur mon fichier final que je te joins
peux tu jeter un oeil stp ?
merci infiniment

 

[sebbbbb]

sans la protection
désolé

 

[sylvanu]

La macro devait se mettre dans ThisWorkbook.
Je l'ai modifié car je m'arrêtais au premier "segment", là je ne traite que les lignes dont la colonne C est non vide. ( car les lignes bleues et noires ont T>0 mais le reste vide )

A noter que j'ai "rempli" toutes les cellules orange au pif, sinon je ne pouvais pas enregistrer. 😅😂🤣

 

[fanch55]

Bonjour @sylvanu, @sebbbbb
un peu en retard, code à mettre dans le module thisworkbook et à sauvegarder en " mode création "

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)

    If Not ThisWorkbook.Saved Then
        Select Case MsgBox("Voulez-vous sauvegarder ce classeur", vbQuestion + vbYesNoCancel)
        Case vbCancel:  Cancel = True
        Case vbNo:      ThisWorkbook.Saved = True
        Case vbYes
            ThisWorkbook.Save
            If Not ThisWorkbook.Saved Then Cancel = True
        End Select
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Zone    As Range
Dim C       As Variant
Dim Msg     As String

    Worksheets("Trafic").Activate
    
    For Each Zone In Range("A6:T" & Range("A" & Rows.Count).End(xlUp).Row - 2).Rows
        If Val(Zone.Columns("T")) > 0 Then
            For Each C In Array("E", "F", "M", "N")
                If Zone.Columns(C) = "" Then
                    Msg = Msg & vbLf & "ligne " & Zone.Row & " incomplète"
                    Exit For
                End If
            Next
        End If
    Next
    
    If Msg <> "" Then
        MsgBox "Sauvegarde abandonnée" & vbLf & Msg, vbCritical
        Cancel = True
    End If

End Sub

 

[fanch55]

Aarrff !!! vraiment en retard, pas vu le dernier document.... 😳🤔🤒

 

[sylvanu]

Aarrff !!! vraiment en retard, pas vu le dernier document....

De plus le fichier comporte un piège, des lignes ( les bleues et les noires ) qui ont T>0 et les autres cellules vides, il faut donc faire une exception pour celles ci.

 

[fanch55]

Oki, à essayer :
on ne traite que les lignes "sans couleur" 🤗
@sylvanu, tu peux sauvegarder en bypassant le beforesave en te mettant en "Mode Création" sur l'onglet Développeur.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    If Not ThisWorkbook.Saved Then
        Select Case MsgBox("Voulez-vous sauvegarder ce classeur", vbQuestion + vbYesNoCancel)
        Case vbCancel:  Cancel = True
        Case vbNo:      ThisWorkbook.Saved = True
        Case vbYes
            ThisWorkbook.Save
            If Not ThisWorkbook.Saved Then Cancel = True
        End Select
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Zone    As Range
Dim C       As Variant
Dim Msg     As String

    Worksheets("Trafic").Activate
    
    For Each Zone In Range("A6:T" & Range("A" & Rows.Count).End(xlUp).Row).Rows
        If Zone.Interior.ColorIndex = xlNone And Val(Zone.Columns("T")) > 0 Then
            For Each C In Array("E", "F", "M", "N")
                If Zone.Columns(C) = "" Then
                    Msg = Msg & vbLf & "ligne " & Zone.Row & " incomplète"
                    Exit For
                End If
            Next
        End If
    Next
    
    If Msg <> "" Then
        MsgBox "Sauvegarde abandonnée" & vbLf & Msg, vbCritical
        Cancel = True
    End If

End Sub

 

[sebbbbb]

Celà me semble très bien
merci infiniment