Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Usine à gaz

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

Pièces jointes

  • Test bloque qd change de ligne.xlsm
    20.4 KB · Affichages: 37
Dernière édition:
Trier par date Trier par votes

Lone-wolf

XLDnaute Barbatruc
Bonjour Lionel

J'ai un sacré doute, mais enfin... . J'ai supprimer les formules et mis la condition dans la macro.

En PJ Essai N°1
 

Pièces jointes

  • Test bloque qd change de ligne.xlsm
    19.4 KB · Affichages: 32
Vote positif 0 Vote négatif
P

PMO2

XLDnaute Accro
Bonjour,
Essayez avec le code suivant
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim C As Range
'---
If Not Intersect(Target, Range("d7:h20")) Is Nothing Then
  For Each C In Range("j7:j20")
    If C = 1 Then
      If Target.Row <> C.Row Then
        Application.EnableEvents = False
        Range("d" & C.Row & "").Select
        Application.EnableEvents = True
        Exit Sub
      End If
    End If
  Next C
End If
End Sub
 

Pièces jointes

  • Test bloque qd change de ligne_pmo.xlsm
    18.7 KB · Affichages: 38
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir Lone,
Merci d'être encore là

En fait, c'est le contraire dont j'ai besoin.
Je voudrais qu'on ne puisse pas aller sur d'autres ligne tant que la ligne en cours n'est pas complètement renseignée de E à H si D contient une valeur (dans le test, c'est un n° de tel).

 
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re Lionel

Essai N°2

VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim plage As Range, cel As Range

On Error Resume Next
Application.DisplayAlerts = False
If Not Intersect(R, Range("e7:e20")) Is Nothing And R.Count = 1 Then
If R.Offset(0, -1) <> "" Then R.Offset(0, 5) = 1
If Range(R.Offset(1, -1), R.Offset(1, 3)) <> "" Then
MsgBox "Vous ne pouvez pas modifier cette ligne", vbExclamation, "ATTENTION"
Application.Undo
Range(R.Offset(1, -1), R.Offset(1, 3)) = ""
End If
End If
End Sub
 
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re

Erreur de ma part. Essai N°3

VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    Dim plage As Range, cel As Range

    On Error Resume Next
    Application.DisplayAlerts = False
    If Not Intersect(R, Range("e7:e20")) Is Nothing Then
        If R.Offset(0, -1) <> "" Then R.Offset(0, 5) = 1

        For Each cel In Range("e7:h20")
            If cel.Offset(0, 3) = "" And cel <> "" Then
                Range(cel.Offset(1, -1), cel.Offset(1, 3)) = ""
            Else
                Exit Sub
            End If
        Next cel
        Application.Goto R.Offset(-1, 3)
        MsgBox "Vous ne pouvez pas modifier cette ligne", vbExclamation, "ATTENTION"
    End If
End Sub
 
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Merci Lone pour ce nouvel essai.

ça bloque bien mais il faudrait pouvoir modifier la ligne en cours de saisie (voir photo jointe).
Je remet le fichier avec ton dernier code.
 

Pièces jointes

  • Test bloque qd change de ligne_pmo.xlsm
    19.2 KB · Affichages: 31
  • Sans titre.jpg
    100.7 KB · Affichages: 63
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re

Essai N°4
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    Dim plage As Range, cel As Range

    On Error Resume Next
    Application.DisplayAlerts = False
    If Not Intersect(R, Range("e7:e20")) Is Nothing Then
        For Each cel In Range("e7:h20")
            If R.Offset(0, -1) <> "" Then R.Offset(0, 5) = 1
            If R.Offset(-1, 3) = "" And cel <> "" Then
                MsgBox "Vous ne pouvez pas modifier cette ligne", vbExclamation, "ATTENTION"
                Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 3)) = ""
                 ActiveCell.Offset(0, 5) = ""
                Exit For
            End If
        Next cel
        If R.Offset(-1, -1) <> "" Then Exit Sub
    End If
End Sub
 
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re à tous

Essaie N° 6. Lionel il faut mettre les entêtes en ligne 6.

VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    Dim plage As Range, cel As Range

    On Error Resume Next
    Application.DisplayAlerts = False
    If Not Intersect(R, Range("e7:e20")) Is Nothing Then
        For Each cel In Range("e7:h20")
            If R.Offset(0, -1) <> "" Then R.Offset(0, 5) = 1
            If ActiveCell.Offset(-1, 0) = "" Or ActiveCell.Offset(-1, 1) = "" Or _
             ActiveCell.Offset(-1, 2) = "" Or ActiveCell.Offset(-1, 3) = "" Then
                MsgBox "Vous ne pouvez pas modifier cette ligne", vbExclamation, "ATTENTION"
                Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 3)) = ""
                ActiveCell.Offset(0, 5) = ""
                Exit For
            End If
        Next cel
    End If
End Sub
 
Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc
Re Lionel

Quel petit dernier?? . Et le code de PMO se base d'après ce que tu à mis dans la feuille et non sur ce que tu as dit au Post #4.
 

Pièces jointes

  • Test bloque qd change de ligne.xlsm
    20.5 KB · Affichages: 31
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2021 affectation et classement de mes appels selon contenu des cellules en colonnes J ou L ou M
2 3
Réponses
30
Affichages
984
Usine à gaz
  • Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
368
job75
  • Résolu(e)
Microsoft 365 Calendrier : Modifier Target > change R
Réponses
10
Affichages
2 K
Usine à gaz
G
  • Question
XL 2016 Ecrire une boucle pour afficher ensemble dans un userform, toutes ses textbox complétées par la boucle! Voir mon code et photos feuilles joints !
Réponses
8
Affichages
743
vgendron
A
  • Question
XL 2016 Fusionner et centrer des cellules
Réponses
3
Affichages
1 K
Alex6942
A
B
  • Question
XL 2019 Verrouiller des lignes si Date
Réponses
8
Affichages
1 K
job75
  • Question
XL 2010 RESOLU Reconnaître puis copier coller une plage dans une autre feuille
2
Réponses
22
Affichages
2 K
ymanot
  • Question
Microsoft 365 mots selon valeurs - recherche si et sélection
2 3 4
Réponses
46
Affichages
3 K
Usine à gaz
  • Question
XL 2016 Lire dans classeurs fermés et copie si trouve
3 4 5
Réponses
73
Affichages
6 K
Usine à gaz
  • Résolu(e)
Microsoft 365 suite calendrier de Roland_M
2 3 4
Réponses
55
Affichages
5 K
Usine à gaz
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…