Test cellule

laplayast

XLDnaute Occasionnel
Bonsoir,
Je teste une cellule,avec un comptage de valeurs;soit "143"valeurs quand toutes les cellules sont remplies.Mais quand le test se passe,il bogue;et là je ne comprends pas;la boite de dialogue n'apparait pas quand la valeur n'est pas atteinte(143)
Voici le code cela permettra,sans doute de voir le problème.
Merci de votre aide.
laplayast.
-------------------------------------------------------------------------

Private Sub Workbook_SheetActivate(ByVal Sh As Object)



With Sheets("feuille1")

If .Range("K11").Value <> 143 Then

Application.EnableEvents = False

.Activate

Application.EnableEvents = True

.Range("F48:F57,G11:G16,G31,G33:G37,G40:G43,G45,G48:G57,H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H52,H53:H57,H65:H67,H69,O28,B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54,C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69,D4,D8,D11:D17,D28,D52,E11:E16,E37,E39,E53:E54,E65:E67,F4,F11:F16,F31,F33:F37,F40:F43,F45").Select

MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."

Exit Sub '
End If

End With
 

JCGL

XLDnaute Barbatruc
Re : Test cellule

Bonjour à tous,

Les plages sont à vérifier

Code:
Option Explicit

Private Sub Worksheet_Activate()
Dim PlageB As Range, PlageC As Range, PlageD As Range, PlageE As Range, PlageF As Range, PlageG As Range, PlageH As Range, PlageO As Range
With Sheets("F1")
Set PlageB = .Range("B4:B5,B8,B36:B40,B42:B43,B45,B48:B52,B54")
Set PlageC = .Range("C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69")
Set PlageD = .Range("D4,D8,D11,D17,D28,D52")
Set PlageE = .Range("E11:E16,E37,E39,E53:E54,E65:E67")
Set PlageF = .Range("F4,F11:F16,F31,F33:F37,F40:F43,F45,F48:F57")
Set PlageG = .Range("G11:G16,G31,G33:G37,G40:G43,G45,G48:G57")
Set PlageH = .Range("H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H57,H65:H67,H69")
Set PlageO = .Range("O28")
If Range("K11").Value <> 143 Then
Union(PlageB, PlageC, PlageD, PlageE, PlageF, PlageG, PlageH, PlageO).Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
End If
End With
End Sub
A+ à tous
 

job75

XLDnaute Barbatruc
Re : Test cellule

Bonsoir laplayast,

Il y a une limite (je ne sais pas laquelle) au nombre de plages qu'on peut mettre dans le texte d'un Range.

Utilisez donc la fonction Union :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)

With Sheets("Feuil1")

If .Range("K11").Value <> 144 Then
Application.EnableEvents = False
.Activate
Application.EnableEvents = True
[COLOR="Red"]Union[/COLOR](Range("F48:F57,G11:G16,G31,G33:G37,G40:G43,G45,G48:G57,H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H52,H53:H57,H65:H67,H69,O28,B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54,C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69,D4,D8,D11:D17,D28,D52,E11:E16,E37,E39,E53:E54"), _
  Range("E65:E67,F4,F11:F16,F31,F33:F37,F40:F43,F45")).Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
Exit Sub 'utile s'il y a du code après End If...
End If

End With

End Sub

Par ailleurs il y a 144 cellules dans la plage à sélectionner.

Je ne suis pas sûr que l'utilisateur s'y retrouvera parmi toutes ces sélections :confused:

Edit : salut JC :) intéressant non ?

A+
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : Test cellule

Bonjour à tous,
Salut Job :),

Copieur Arf Arf :):),
Je crois que les Range sont limités à 30
J'ai préféré les "colonniser"

Exact aussi pour le NBVAL(), j'en compte 138 et non 143 (mais j'ai pu oublier des cellules au vu du code "non balisé" de notre ami

Je joins le fichier

A++ :)
A+ à tous
 

Pièces jointes

  • JC Test Cellules.xls
    29 KB · Affichages: 39
Dernière édition:

laplayast

XLDnaute Occasionnel
Re : Test cellule

Bonsoir,
Merci pour votre aide et pour la mise en place du code,finalement "JOB75" ton code passe correctement;par contre celui "JCGL"bogue.A savoir quand on laisse 1 cellule vide de la feuille 1 on peut quand même passer à la feuille2 ce qui ne devrait pas se produire.Merci quand même pour ton type de code que je ne connaissais pas.
Par contre je souhaiterai que la cellule "K11" soit sur une autre feuille afin d'eviter des modifs malencontreuses,comment puis-je placer cela dans le code?
Merci de votre aide.
 

job75

XLDnaute Barbatruc
Re : Test cellule

Bonsoir,

Par contre je souhaiterai que la cellule "K11" soit sur une autre feuille (...)

Précisez simplement la feuille => Sheets("xxx").Range("K11")

Alors le bloc With...End With ne présente plus guère d'intérêt.

Edit : votre réponse à JCGL :

quand on laisse 1 cellule vide de la feuille 1 on peut quand même passer à la feuille2 ce qui ne devrait pas se produire

C'est à cause du 143 (au lieu de 144). C'est vous qui êtes fautif :p

A+
 
Dernière édition:

laplayast

XLDnaute Occasionnel
Re : Test cellule

Bonjour,
Le code,pour réaliser le test du nombre de valeurs sur une autre feuille ne fonctionne pas.Je n'arrive pas à le mettre en place.Voici un extrait de ce que j'ai fait.La feuille"protection"contient les cases à remplir,et la"feuille1"contient le test des cellules.La version excel est la "2000"

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

With Sheets("protection")

If Sheets("feuille1").Range("A13").Value <> 143 Then

Application.EnableEvents = False

.Activate

Application.EnableEvents = True
-----------------------------------------------------------------
Merci de votre aide.
laplayast.
 

JCGL

XLDnaute Barbatruc
Re : Test cellule

Bonjour à tous,

Peux-tu tester ce fichier ?

Si cela ne correspond pas, je ne continuerai pas sans ton fichier

A+ à tous

Edition : Salut Job
 

Pièces jointes

  • Test Cellules non Renseignees.xls
    38 KB · Affichages: 24
Dernière édition:

job75

XLDnaute Barbatruc
Re : Test cellule

Bonjour laplayast, JC,

JC à mon avis laplayast ne veut pas qu'on aille en feuille F2 si la plage en F1 n'est pas entièrement remplie, donc ton code doit être en feuille F2 (ou dans ThisWorkbook avec SheetActivate s'il y a plus de 2 feuilles).

Il faut alors ajouter Sheets("F1").Activate avant de sélectionner la plage.

Pas compris pourquoi laplayast s'acharne avec 143, alors qu'on a dit et redit que c'était 144...

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Test cellule

Re,

En fait je ne vois pas pourquoi laplayast calcule le nombre de cellules remplies dans la feuille.

Plus simple de le faire dans le code. Perso je mettrais dans ThisWorkbook :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "F1" Then Exit Sub
Dim PlageB As Range, PlageC As Range, PlageD As Range, PlageE As Range, PlageF As Range, PlageG As Range, PlageH As Range, PlageO As Range, Plage As Range
With Sheets("F1")
Set PlageB = .Range("B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54")
Set PlageC = .Range("C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69")
Set PlageD = .Range("D4,D8,D11:D17,D28,D52")
Set PlageE = .Range("E11:E16,E37,E39,E53:E54,E65:E67")
Set PlageF = .Range("F4,F11:F16,F31,F33:F37,F40:F43,F45,F48:F57")
Set PlageG = .Range("G11:G16,G31,G33:G37,G40:G43,G45,G48:G57")
Set PlageH = .Range("H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H57,H65:H67,H69")
Set PlageO = .Range("O28")
Set Plage = Union(PlageB, PlageC, PlageD, PlageE, PlageF, PlageG, PlageH, PlageO)
If Application.CountA(Plage) < Plage.Count Then
.Activate
Plage.Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
End If
End With
End Sub

Pas besoin non plus des EnableEvents :)

A+
 

job75

XLDnaute Barbatruc
Re : Test cellule

Re,

Oh et puis bof, je sélectionnerais seulement les cellules vides dans la plage ;)

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "F1" Then Exit Sub
Dim PlageB As Range, PlageC As Range, PlageD As Range, PlageE As Range, PlageF As Range, PlageG As Range, PlageH As Range, PlageO As Range, Plage As Range
With Sheets("F1")
Set PlageB = .Range("B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54")
Set PlageC = .Range("C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69")
Set PlageD = .Range("D4,D8,D11:D17,D28,D52")
Set PlageE = .Range("E11:E16,E37,E39,E53:E54,E65:E67")
Set PlageF = .Range("F4,F11:F16,F31,F33:F37,F40:F43,F45,F48:F57")
Set PlageG = .Range("G11:G16,G31,G33:G37,G40:G43,G45,G48:G57")
Set PlageH = .Range("H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H57,H65:H67,H69")
Set PlageO = .Range("O28")
Set Plage = Union(PlageB, PlageC, PlageD, PlageE, PlageF, PlageG, PlageH, PlageO)
If Application.CountA(Plage) < Plage.Count Then
.Activate
Plage.[COLOR="Red"]SpecialCells(xlCellTypeBlanks).[/COLOR]Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
End If
End With
End Sub

A+
 

JCGL

XLDnaute Barbatruc
Re : Test cellule

Bonjour à tous,
salut Job

Si toutes les cellules sont renseignées :
Code:
Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "F1" Then Exit Sub
Dim PlageB As Range, PlageC As Range, PlageD As Range, PlageE As Range, PlageF As Range, PlageG As Range, PlageH As Range, PlageO As Range, Plage As Range
With Sheets("F1")
Set PlageB = .Range("B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54")
Set PlageC = .Range("C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69")
Set PlageD = .Range("D4,D8,D11:D17,D28,D52")
Set PlageE = .Range("E11:E16,E37,E39,E53:E54,E65:E67")
Set PlageF = .Range("F4,F11:F16,F31,F33:F37,F40:F43,F45,F48:F57")
Set PlageG = .Range("G11:G16,G31,G33:G37,G40:G43,G45,G48:G57")
Set PlageH = .Range("H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H57,H65:H67,H69")
Set PlageO = .Range("O28")
Set Plage = Union(PlageB, PlageC, PlageD, PlageE, PlageF, PlageG, PlageH, PlageO)
[B][COLOR=Red]If Application.CountA(Plage) = Plage.Count Then Exit Sub[/COLOR][/B]
If Application.CountA(Plage) < Plage.Count Then .Activate
Plage.SpecialCells(xlCellTypeBlanks).Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
End With
End Sub
A++
A+ à tous
 

job75

XLDnaute Barbatruc
Re : Test cellule

Re,

Là tu pousses JC :p alors je pousse un peu plus :p:p

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim PlageB As Range, PlageC As Range, PlageD As Range, PlageE As Range, PlageF As Range, PlageG As Range, PlageH As Range, PlageO As Range, Plage As Range
With Sheets("F1")
Set PlageB = .Range("B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54")
Set PlageC = .Range("C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69")
Set PlageD = .Range("D4,D8,D11:D17,D28,D52")
Set PlageE = .Range("E11:E16,E37,E39,E53:E54,E65:E67")
Set PlageF = .Range("F4,F11:F16,F31,F33:F37,F40:F43,F45,F48:F57")
Set PlageG = .Range("G11:G16,G31,G33:G37,G40:G43,G45,G48:G57")
Set PlageH = .Range("H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H57,H65:H67,H69")
Set PlageO = .Range("O28")
Set Plage = Union(PlageB, PlageC, PlageD, PlageE, PlageF, PlageG, PlageH, PlageO)
[COLOR="Red"]If Sh.Name = .Name Or Application.CountA(Plage) = Plage.Count Then Exit Sub[/COLOR]
.Activate
Plage.SpecialCells(xlCellTypeBlanks).Select
MsgBox "Merci de bien vouloir remplir les cellules sélectionnées !", vbCritical, "ATTENTION ..."
End With
End Sub

A+
 
Dernière édition:

laplayast

XLDnaute Occasionnel
Re : Test cellule

Bonsoir,JCGL,JOB75,

Merci de votre aide,et je vais essayer d'être plus clair."JOB75" à raison quand il dit que l'on ne peut pas aller en"Feuille2"si "F1",n'est pas remplie;ceci est la condition 1.La condition suivante c'est qu'il y aura 4 feuilles qui seront construite sur le même principe.Toutes les feuilles de données seront testées,avec la feuille "test"ou pour chaque feuille un test de valeur se produira.
On ne peut pas accéder à la feuille suivante,si la précédente n'est pas remplie;et là le message "REMPLIR LES CELLULES"s'affiche.Je souhaiterai utiliser le code que je possède déjà;est-ce possible?.
Merci de votre aide à cette mise en place.

LAPLAYAST.
--------------------------------------------------------------------------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)



With Sheets("protection")

If Sheets("test").Range("A13").Value <> 143 Then

Application.EnableEvents = False

.Activate

Application.EnableEvents = True

Union(Range( _
"F48:F57,G11:G16,G31,G33:G37,G40:G43,G45,G48:G57,H11:H17,H30:H31,H33:H37,H40:H43,H45,H48:H52,H53:H57,H65:H67,H69,O28,B4:B5,B8,B33:B36,B40,B42:B43,B45,B48:B52,B54,C30:C32,C37:C39,C44,C53,C55:C57,C65:C66,C69" _
), Range( _
"D4,D8,D11:D17,D28,D52,E11:E16,E37,E39,E53:E54,E65:E67,F4,F11:F16,F31,F33:F37,F40:F43,F45" _
)).Select
MsgBox "MERCI DE BIEN VOULOIR REMPLIR LES CELLULES EN GRIS !", vbCritical, "ATTENTION ..."

Exit Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 239
Messages
2 086 497
Membres
103 236
dernier inscrit
Menni