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

vgendron

XLDnaute Barbatruc
hello
un truc comme ca?
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Intersect(R, Range("A7:E7")) Is Nothing Then
        If [f3] <> "OK" Then
            MsgBox ("Il manque des infos dans votre ligne !" & nbcel)
            Range("A7").Select
            Exit Sub
        End If
    End If
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re- vgendron,

Je testa et ça ne marcha pas :(


Si les cellule de la ligne en cours, par exemple : A7 à E7
ne sont pas remplies,
On ne doit pas pouvoir cliquer dans les cellules de A8 à A10000 (affichage du msg box)

Je remets le fichier avec ton code en cas d'une possible solution.

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

Pièces jointes

  • Test bloque déplacement.xlsm
    16.8 KB · Affichages: 29

Lone-wolf

XLDnaute Barbatruc
Re Lionel

Je ne sais pas si j'ai bien compris, un test avec ceci

VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)

If ActiveCell.Offset(0, -1) = vbNullString Then
MsgBox "Il manque des infos dans votre ligne !", , "ATTENTION !"
Application.Goto ActiveCell.Offset(0, -1)
Exit Sub
End If

End Sub
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Lone,

Merci de m'avoir répondu mais ça ne fonctionne pas : ça bloque tout.

Le but est d'avoir accès à la ligne de saisie (celle dans laquelle il manquer des infos) et de ne pas pouvoir en sortir tant que toutes les infos n'y sont pas.

Je remets un fichier avec 3 feuille :
Lionel,
Vgendron,
Lone,

Bonne soirée,
Amicalement,
arthour973
 

Pièces jointes

  • Test bloque déplacement.xlsm
    22.3 KB · Affichages: 38
  • Test bloque déplacement.xlsm
    22.3 KB · Affichages: 35

laetitia90

XLDnaute Barbatruc
bonsoir tous:):):):);)
le peu que je comprends ???on pourrait manipuler ScrollArea ... egalement Comment... a la place de msgbox peut être plus simple
un exemple tres "brut"
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    If [f3] = "OK" Then Sheets(1).ScrollArea = ""
  End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If [f3] <> "OK" Then Sheets(1).ScrollArea = ("A7:E7")
End Sub

mais bon pas le temps d'approfondir :(
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Merci laetitia, pour vos codes.
J'ai testé mais je ne m'en sortais pas :confused:

Avec l'aide des codes que vous avez eu tous la gentillesse de me donner, j'ai pu plancher (ça m'arrive LOL) et j'ai réussi à résoudre mon souci (enfin, je pense) en profane que je suis toujours, :confused:

A l'évidence, ça pourrait certainement être mieux codé LOL.
Je joins le fichier.

Bon WE à toutes et à tous,
Amicalement,
arthour973,
 

Pièces jointes

  • Test bloque déplacement.xlsm
    19.1 KB · Affichages: 35

Roland_M

XLDnaute Barbatruc
bonjour tout le monde,

tout en un seul !
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Cells(ActiveCell.Row, 2) = "" And [g3] = "OK" And [k3] = "OK" Then Exit Sub
Application.ScreenUpdating = False: Application.EnableEvents = False
If [g3] <> "OK" Then Rang$ = "b7:F10000": GoTo suite
If [g3] = "OK" And [k3] <> "OK" Then Rang$ = "i7:j10000": GoTo suite
Exit Sub
suite: '<
Application.ScreenUpdating = False: Application.EnableEvents = False
Range(Rang$).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveWindow.ScrollRow = Selection.Row
'MsgBox "Il manque des infos dans votre ligne no " & ActiveCell.Row
Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
[\code]

EDIT: j'avais fais une erreur ! c'est rectifié !
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

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
tant que les cellules, par exemple, en ligne n de A à E ne sont pas renseignées :
VB:
Private Sub Worksheet_Change(ByVal R As Range)
If Not Application.CountA(Cells(R.Row, 1).Resize(, 5)) = 5 Then
MsgBox "Veuillez remplir les cellules:" & Cells(R.Row, 1).Resize(, 5).Address(0, 0)
R.Offset(, 1).Select
Else
Cells(R.Row + 1, 1).Select
End If
End Sub

NB: Il y a quelque effets de bord que je vous laisse découvrir ;)
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
LOL Roland,
A l'évidence le pro fait bien mieux ;)

Juste une p'tite question
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.

Je tente de modifier ces codes trouvés mais je n'y arrive pas :
[b7].End(xlDown).Select
([b7] & Rows.Count).End(xlUp).Row
DerLg = Sheets("Feuil1").Cells(Columns(5).Cells.Count, 2).End(xlUp).Row
dernligne=[b7] & Rows.Count).End(xlUp).Row
Range([b7], ActiveCell.SpecialCells(xlLastCell)).Select

Encore merci Roland ton code est top :)
Amicalement,
arthour973
 

Discussions similaires

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