XL 2010 Resolu par PMO2 et Lone Wolf : Blocage si saisie incomplète

[Usine à gaz]

Bonjour à toutes et à tous,

Me revoilou devant un nouveau petit souci.
Malgré mes recherches, je n'ai pas trouvé la solution.

Voici ce qui m'amène :
Objectif (fichier test joint) :
si la cellule col "J" de la ligne en cours de saisie contient "1"
Interdire la saisie dans les cellules des autres lignes

Mon problème
Le code verrouille bien. Mais il bloque la saisie de la ligne en cours de saisie

Ma demande
Un code "bloquant" que si l'on clique hors de la ligne qui contient le "1" en col J.

J'espère être compréhensible LOL
Un grand merci déjà d'avoir lu mon post.
Je vous souhaite une bonne journée à toutes et à tous,
Amicalement,
Lionel,

 

[Usine à gaz]

Re Lone,
Les essais 4 et 6 fonctionnent différemment de ma pensée mais le résultat et obtenu.
Merci à toi.

 

[PMO2]

@Lone-wolf
Merci beaucoup pour les éclaircissements.

 

[Usine à gaz]

Bonjour PMO2,
Bonjour Lone Wol, ... Le Forum

Grâce à vous deux, j'ai résolu mon souci et j'ai pu intégrer le code dans mon fichier de travail.
Mais il reste un petit point de confort et de gain de temps

Private Sub Worksheet_SelectionChange(ByVal R As Range)

    Dim C As Range
If Not Intersect(R, Range("g7:v20000")) Is Nothing Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
  For Each C In Range("y7:y20000")
    If C = 1 Then
      If R.Row <> C.Row Then
        Application.EnableEvents = False
        Oubli_date.Show
        Range("d" & C.Row & "").Select
        Application.EnableEvents = True
        Exit Sub
      End If
    End If
  Next C
  R.Select
End If

Ce code me sélectionne bien la cellule "R.Select" mais il ne m'y renvoie pas.
Mon fichier contient en moyenne 20.000 lignes et il me faut faire une recherche de la cellule pour y arriver.

Est-il possible d'ajouter une ligne de code pour atteindre la cellule "R.Select" ?

J'ai tenté:

On Error Resume Next
Application.Goto Range(R)

Range(Range(R)).Select

Et d'autres mais ça ne marche pas.

Encore un grand Merci,
Amicalement,
Lionel,

 

[PMO2]

Essayez avec le code suivant

Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim C As Range
If Not Intersect(R, Range("g7:v20000")) Is Nothing Then
'''    Application.EnableEvents = False  'inutile
'''    Application.ScreenUpdating = False   '???
  For Each C In Range("y7:y20000")
    If C = 1 Then
      If R.Row <> C.Row Then
        Application.EnableEvents = False
'''        Oubli_date.Show  'instruction déplacée plus bas
        Range("g" & C.Row & "").Select 'modif (c'est en colonne G je suppose)
        Oubli_date.Show   'l'UserForm apparaît APRES la sélection
        Application.EnableEvents = True
        Exit Sub
      End If
    End If
  Next C
'''  R.Select  'pas bon je crois
End If

 

[Usine à gaz]

Re PM2,

Super, ça fonctionne maintenant.
J'ai modifié : Range("g" & C.Row & "")
J'ai supprimé "R.Select 'pas bon je crois"

Merci d'avoir été là,
Amicalement,
Lionel,