Microsoft 365 MSGBOX pour une cellule non remplie

[Didier03]

Bonjour le forum,
voilà je cherche le moyen d'afficher un msgbox si une cellule n'est pas remplie sous une certaine condition,

dans la colonne A je rentre une date et dès que cette date est marquée il faut impérativement remplir les colonnes F et G sur la même ligne
si on tente de sauvegarder sans remplir des deux cellules,cela bloque et affiche un message qu'il faut remplir ces deux cellules
j'ai fait des recherche sur le forum , mais je n'ai rien trouvé , j'espère ne pas avoir fait une question en doublon

merci de votre aide
en vous souhaitant une bonne journée

 

[sylvanu]

Bonjour Didier,
Vous n'auriez pas un petit fichier test ? Ce serait plus simple pour comprendre le contexte.

 

[Didier03]

Bonjour Sylvanu,
ok vais prépaprer ça
merci

 

[job75]

Bonjour Didier03, sylvanu, le forum,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
With Sheets("Feuil1")
    Set r = Intersect(.Range("A2:A" & .Rows.Count), .UsedRange)
    If r Is Nothing Then Exit Sub
    For Each r In r
        If IsDate(r) Then
            If r(1, 6) = "" Or r(1, 7) = "" Then
                Cancel = True
                r(1, 7 + (r(1, 6) = "")).Select
                MsgBox "La plage " & r(1, 6).Resize(, 2).Address(0, 0) & " doit être remplie..."
                Exit For
            End If
        End If
    Next
End With
End Sub

Elle se déclenche quand on essaie d'enregistrer le fichier.

A+

 

[Didier03]

voila colonne en jaune où l'on met la date et colonnes vertes à remplir obligatoirement dès que l'on met la date

merci beaucoup

 

[Didier03]

Bonjour Didier03, sylvanu, le forum,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
With Sheets("Feuil1")
    Set r = Intersect(.Range("A2:A" & .Rows.Count), .UsedRange)
    If r Is Nothing Then Exit Sub
    For Each r In r
        If IsDate(r) Then
            If r(1, 6) = "" Or r(1, 7) = "" Then
                Cancel = True
                r(1, 7 + (r(1, 6) = "")).Select
                MsgBox "La plage " & r(1, 6).Resize(, 2).Address(0, 0) & " doit être remplie..."
                Exit For
            End If
        End If
    Next
End With
End Sub

Elle se déclenche quand on essaie d'enregistrer le fichier.

A+

merci beaucoup job75 , j'avais pas vu ton message avant que je mette un fichier test , je vais tester ça

 

[job75]

Vous parliez de colonne A maintenant c'est la colonne B :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
With Sheets("Feuil1")
    Set r = Intersect(.Range("B3:B" & .Rows.Count), .UsedRange)
    If r Is Nothing Then Exit Sub
    For Each r In r
        If IsDate(r) Then
            If r(1, 5) = "" Or r(1, 6) = "" Then
                Cancel = True
                r(1, 6 + (r(1, 5) = "")).Select
                MsgBox "La plage " & r(1, 5).Resize(, 2).Address(0, 0) & " doit être remplie..."
                Exit For
            End If
        End If
    Next
End With
End Sub

 

[Didier03]

Cette macro marche très quand tout est rempli au fur et à mesure , sauf que sur mon fichier il est possible que j'ai des cellules vident entre les pleines et la macro me l'arrête même s'il n'y a pas de date, je vous ais joint un fichier pour voir

 

[Didier03]

Vous parliez de colonne A maintenant c'est la colonne B :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim r As Range
With Sheets("Feuil1")
    Set r = Intersect(.Range("B3:B" & .Rows.Count), .UsedRange)
    If r Is Nothing Then Exit Sub
    For Each r In r
        If IsDate(r) Then
            If r(1, 5) = "" Or r(1, 6) = "" Then
                Cancel = True
                r(1, 6 + (r(1, 5) = "")).Select
                MsgBox "La plage " & r(1, 5).Resize(, 2).Address(0, 0) & " doit être remplie..."
                Exit For
            End If
        End If
    Next
End With
End Sub

oui désolé comme j'ai fait un fichier test j'ai pas mis sur les bonnes colonnes , mais ça je peut modifier pas de soucis merci beaucoup de vos retours

 

[Usine à gaz]

Usine à gaz : sors de ce corps lol

 

[Didier03]

Usine à gaz : sors de ce corps lol

oui suis pas très doué lol désolé

 

[job75]

Vous aurez remarqué que quand on change de colonne il faut modifier les positions relatives des cellules.

Bonjour Lionel

 

[Usine à gaz]

Bjr, Gérard , Bjr le fil

 

[Didier03]

Vous aurez remarqué que quand on change de colonne il faut modifier les positions relatives des cellules.

Bonjour Lionel

ok vais regarder ce que j'ai modifié
merci beaucoup

 

[Didier03]

Grand merci job75 ça marche très bien !!!!!! , comme d'hab c'est moi qui mal fait lol
merci beaucoup de votre aide et de votre temps passé !!!!