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

sebbbbb

XLDnaute Impliqué
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
 

Pièces jointes

  • TEST.xlsm
    21.2 KB · Affichages: 12

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • TEST.xlsm
    14.7 KB · Affichages: 5

sebbbbb

XLDnaute Impliqué
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

XLDnaute Barbatruc
Supporter XLD
En PJ un essai à tester avec :
VB:
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é". :)
 

Pièces jointes

  • TEST (3).xlsm
    20.7 KB · Affichages: 5

sebbbbb

XLDnaute Impliqué
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
 

Pièces jointes

  • fichier stats.xlsm
    68.4 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
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. 😅😂🤣
 

Pièces jointes

  • fichier stats (2).xlsm
    62 KB · Affichages: 8

fanch55

XLDnaute Barbatruc
Bonjour @sylvanu, @sebbbbb
un peu en retard, code à mettre dans le module thisworkbook et à sauvegarder en " mode création "
VB:
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

XLDnaute Barbatruc
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.

VB:
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
 

Discussions similaires

Réponses
14
Affichages
1 K