XL 2013 Ne pas exécuter le code sur la ligne cellule active

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite tout d'abord un très beau dimanche.

Me revoilà "encore" pour un nouveau souci que je me permets de vous soumettre
But de l'opération :
Quand la cellule A d'une ligne est renseignée
toutes les colonnes (A à X) doivent être renseignées avant de pouvoir commencer
une nouvelle ligne ou avant d'aller sur un autre ligne pour la modifier.

Les codes fonctionnent sans souci et la ligne en erreur (une ou plusieurs cellules non renseignées) est atteinte

Mon souci :
J'ai besoin que le code ne s'exécute pas sur la ligne en erreur afin que je puisse renseigner la ou les colonnes non renseignées

Je planche mais malgré mes essais et recherches, je n'arrive pas à trouver la solution.

En espérant que le fichier test joint sera compréhensif, je vous remercie une fois encore pour votre bienveillante gentillesse.

Amicalement,
Lionel,

 

[Patrice33740]

Bonjour,

Essaies ce code dans le module de feuille (sans les autres modules) :

Private Sub Worksheet_SelectionChange(ByVal T As Range)
  If Intersect(T, [A7:X10000]) Is Nothing Then Exit Sub
  Dim C As Range
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  With Range("Y7:Y10000")
    .FormulaR1C1 = "=IF(AND(RC[-24]<>"""",COUNTBLANK(RC[-23]:RC[-1])),1,"""")"
    Me.Calculate
    .Value = .Value
    Set C = .Find(What:="1")
    If Not C Is Nothing Then
      Cells(C.Row, ActiveCell.Column).Activate
    End If
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Edit : Plus rapide :

Private C As Range
Private Sub Worksheet_Change(ByVal T As Range)
  If Intersect(T, [A7:X10000]) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  With Range("Y7:Y10000")
    .FormulaR1C1 = "=IF(AND(RC[-24]<>"""",COUNTBLANK(RC[-23]:RC[-1])),1,"""")"
    Me.Calculate
    .Value = .Value
    Set C = .Find(What:="1")
    If Not C Is Nothing Then
      Cells(C.Row, ActiveCell.Column).Activate
    End If
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
  If Intersect(T, [A7:X10000]) Is Nothing Then Exit Sub
  If Not C Is Nothing Then
    Application.EnableEvents = False
    Cells(C.Row, ActiveCell.Column).Activate
    Application.EnableEvents = True
  End If
End Sub

 

[pierrejean]

Bonjour Lionel

Vois si cela te convient

 

[Usine à gaz]

Bonjour Patrice33740,

Merci pour cette réponse rapide et vos codes.

J'ai un peu modifié le 1er code et ça semble bien fonctionner cf fichier joint.
J'ai rien compris au second d'autant qu'il en a 2.
Je pense cependant que le 1er sera plus facile à intégrer dans mon fichier de travail.

Un grand merci,
Amicalement,
Lionel,

 

[Usine à gaz]

Bonjour PierreJean,

Super Merci, ça marche nickel,
Bon dimanche,
Amicalement,
Lionel,

 

[Patrice33740]

Bonjour Patrice33740,

Merci pour cette réponse rapide et vos codes.

J'ai un peu modifié le 1er code et ça semble bien fonctionner cf fichier joint.
J'ai rien compris au second d'autant qu'il en a 2.
Je pense cependant que le 1er sera plus facile à intégrer dans mon fichier de travail.

Un grand merci,
Amicalement,
Lionel,

Dans le second code j'utilise les 2 évènements Change et SélectionChange
- Change pour détecter l'erreur qui ne peut survenir que dans ce cas (changement du contenu d'une cellule) et pour définir la cellule correspondante.
- SélectionChange pour revenir sur la ligne dans le cas où une erreur existe : Il est inutile de chercher une erreur à chaque changement de sélection, car elle ne se produit que lorsque le contenu de la ligne est modifié et ça ralentit énormément la macro pour rien.

EDIT :
Les lignes suivantes sont inutiles :

    If [t4] <> "OK" Then
    ActiveWindow.ScrollRow = Selection.Row
    End If

Il suffit d'écrire :

    If Not C Is Nothing Then
      Cells(C.Row, ActiveCell.Column).Activate
      ActiveWindow.ScrollRow = C.Row
    End If
  End With

Patrice