XL 2013 Code qui bloque trop

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Je me permets une fois de plus de venir vers vous pour un souci de code que je n'arrive pas à résoudre, malgré mes recherches et essais.

Le code feuille ci-dessous me permet de bloquer la sortie de la ligne tant que les cellules, par exemple, en ligne 7 de A à E ne sont pas renseignées :
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If [f3] <> "OK" Then
    MsgBox ("Il manque des infos dans votre ligne !" & nbcel)
    Exit Sub
    End If
End Sub

Mon souci est que le code bloque si bien que je ne peux pas compléter ma ligne.

Pourriez-vous m'aider ? pour un code qui me permette le blocage mais qui me laisse la possibilité de remplir ma ligne.

Je joins un fichier test.

Avec mes remerciements,
Je vous souhaite à toutes et à tous une belle journée,
Amicalement,
Arthour973,
 

Pièces jointes

  • Test bloque déplacement.xlsm
    17 KB · Affichages: 37

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Roland,

Code:
J'aimerais remplacer les codes :
- [b7:F10000].Select ou - Rang$ = "b7:F10000"
pour que le code sélectionne jusqu'à la dernière cellule non vide de la plage.
J'ai trouvé :
Code:
Range([b7], Cells(Rows.Count, 6).End(xlUp)).Select
Mais je n'arrive pas coder ça dans ton code.
Bon WE,
Amicalement,
arthour973
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Staple1600,

Je dois avoir les yeux bouchés de M LOL
j'avais bien mis ton code dans une feuille où il n'y avait que ton code.
J'ai donc ouvert un nouveau classeur en mettant ton code dans la feuille, donc pas d'autre code dans le classeur et ..... même résultat.

Pour voir si j'ai vraiment zappé un truc, je remets le fichier avec ton code dans la feuille "Staple1600" (il n'y a que ton code dans la feuille)

Tu pourrais voir ce qui se passe dans les deux autres feuilles ?
@plusssssss ;)
 

Pièces jointes

  • Test bloque déplacement1.xlsm
    32.1 KB · Affichages: 30

Staple1600

XLDnaute Barbatruc
Re

@arthour973
Tu as mis le code dans la feuille
Et quand tu saisis un chiffre en A1, puis que tu fais ENTER, il n'y a pas de MsgBox qui s'affiche chez toi?

NB: J'ai bien dit de créer un classeur vierge (avec une seuie feuille)
Pas de reprendre ton fichier exemple et d'y ajouter une feuille.
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Si, Si, ça s'affiche mais ce n'est pas vraiment ce que je recherche.

Ce que je recherche est :
au clic dans n'importe quelle cellule, sélection de la cellule vide dans la plage [b7:F10000] ou [i7:j10000]
et afficher en dessous de la ligne 6 la ligne plage non complétée


Si tu télécharges le fichier, tu peux voir les 2 autres onglets qui font l'action.
Amicalement,
arthour973
 

Staple1600

XLDnaute Barbatruc
Re

@arthour973
Ce n'est pas moins qui ait écrit ceci dans le message 1
par exemple, en ligne 7 de A à E ne sont pas renseignées

par contre j'ai bien écrit ceci
Dans une feuille, où il n'y a que cette procédure événementielle
La saisie est guidée selon ce qui est indiqué dans le message#1

J'ai donc suivi le cahier des charges initial et mon code réponds donc à cette contrainte ;)

Donc testes selon les conditions que tu as toi-même définies dans le message#1
Fais une saisie en A1
Le MsgBox s'affiche et t'oblige à saisir en B1
Le MsgBox s'affichera tant que E1ne sera pas rempli
Dés que E1 est rempli, hop tu te retrouves en A2
etc....
Le MsgBox s'affiche et t'oblige à saisir en BN
Le MsgBox s'affichera tant que EN ne sera pas rempli
Dés que EN est rempli, hop tu te retrouves en AN+1

NB: N= Numéro de ligne
 

Roland_M

XLDnaute Barbatruc
re

si c'est ça !? voir comme ceci:
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Cells(ActiveCell.Row, 2) = "" And [g3] = "OK" And [k3] = "OK" Then Exit Sub
If [g3] <> "OK" Then Rang$ = Range([b7], Cells(Rows.Count, "F").End(xlUp)).Address: GoTo suite
If [g3] = "OK" And [k3] <> "OK" Then Rang$ = Range([i7], Cells(Rows.Count, "J").End(xlUp)).Address: GoTo suite
Exit Sub
suite: '<
Application.ScreenUpdating = False: Application.EnableEvents = False
Range(Rang$).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.ScreenUpdating = True
ActiveWindow.ScrollRow = Selection.Row
MsgBox "Il manque des infos dans votre ligne no " & ActiveCell.Row
Application.EnableEvents = True
End Sub

EDIT: j'ai rectifié un oubli cette ligne n'était pas à sa place !
Application.ScreenUpdating = False: Application.EnableEvents = False
idem dans mon dernier message ! (excuses j'avais fait un peu trop vite car je dois repartir !)
 
Dernière édition:

Roland_M

XLDnaute Barbatruc
re

j'ai rectifié un oubli cette ligne n'était pas à sa place !
Application.ScreenUpdating = False: Application.EnableEvents = False
de ce fait l'événement ne se reproduisait plus au passage sans erreur, ça sortait sans remettre à true !?

reprend ce code:
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Cells(ActiveCell.Row, 2) = "" And [g3] = "OK" And [k3] = "OK" Then Exit Sub
If [g3] <> "OK" Then Rang$ = Range([b7], Cells(Rows.Count, "F").End(xlUp)).Address: GoTo suite
If [g3] = "OK" And [k3] <> "OK" Then Rang$ = Range([i7], Cells(Rows.Count, "J").End(xlUp)).Address: GoTo suite
Exit Sub
suite: '<
Application.ScreenUpdating = False: Application.EnableEvents = False
Range(Rang$).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.ScreenUpdating = True
ActiveWindow.ScrollRow = Selection.Row
MsgBox "Il manque des infos dans votre ligne no " & ActiveCell.Row
Application.EnableEvents = True
End Sub
 

Pièces jointes

  • Test bloque déplacement_Rol_M.xlsm
    16.8 KB · Affichages: 28
Dernière édition:

Discussions similaires

Réponses
6
Affichages
408
Réponses
5
Affichages
365
Réponses
4
Affichages
491