Problème Message Box

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Je fais appel à vos connaissance pour un petit bug (erreur de ma part) sur un Message Box.
Je vous explique :
- A l'ouverture d'un fichier, je demande la recherche dans mon tableau des cellule vide dans la colonne "M"
- Si cellule vide trouvé (ex : "M12") => Message Box avec les infos des cellule "B12 et C12 et D12 (c'est Mr/Mme et Nom et Prénom dans mon tableau).
Ceci marche bien.

Mon problème vient quand j'ai 2 (ou 3 ou plus) cellules vides :
Exemples si 3 cellules vides dans mon tableau :
-M12 vide => Message Box avec valeurs B12 et C12 et D12
je fait OK
Il continue son balayage
-M16 vide => Message Box avec valeurs B12,C12,D12 et B16,C16,D16
je fait OK
Il continue son balayage
-M24 vide => Message Box avec valeurs B12,C12,D12 et B16,C16,D16 et M24,C24,D24
je fait Ok
Il continue son balayage mais pas plus de cellule vide donc OK

Voila, je souhaiterais arriver à l'étape 3 directement. Qu'il me trouve toutes les cellules vides et qu'il m'affiche toutes les infos correspondantes en 1 Message Box.
Code:

1 2 3 4 5 6 7 8 9 Dim Cel As Range, iRow&, Certificat$, iRow = Range("M" & Rows.Count).End(xlUp).Row For Each Cel In Range("M3:M" & iRow) If Cel.Value = "" Then Certificat = Certificat & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat" End If Next
Si quelqu'un peut me dire quoi faire pour résoudre mon problème ?
Merci.

Bonjour,

Citation:

Voila, je souhaiterais arriver à l'étape 3 directement. Qu'il me trouve toutes les cellules vides et qu'il m'affiche toutes les infos correspondantes en 1 Message Box.

Il te suffit de sortir le msgbox de ta boucle:
Code:

1 2 3 4 5 6 7 8 9 Dim Cel As Range, iRow&, Certificat$, iRow = Range("M" & Rows.Count).End(xlUp).Row For Each Cel In Range("M3:M" & iRow) If Cel.Value = "" Then Certificat = Certificat & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf End If Next MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat"

22/01/2019, 14h25
minifrix

Merci.
C’était tellement simple et logique :oops:
Mais j'étais braquer sur le fait que après "Next", c'était pour changer de fonction.
En tout cas encore merci pour le coup de main.
22/01/2019, 14h48
MarcelG

Slut mimifrix et bienvenu sur le Forum,

Tu pourrais alléger le code en balayant les cellules spéciales vides., sans aucune condition.

Code:

For Each Cel In Range("M3:M" & iRow).Specialcells(xlCellTypeBlanks)

Ce qui éviterait donc un bloc If.

Pour te documenter sur les cellules spéciales, tu peux consulter cet espace.
22/01/2019, 15h22
minifrix

Code:

For Each Cel In Range("M3:M" & iRow).Specialcells(xlCellTypeBlanks)

Merci.
Par un simple copier coller, il me sort une erreur 1004.
Mais c'est sans réfléchir.
Et je ne veux surtout pas la solution, il faut que j'apprenne.
Je sais bien que mes lignes de code ferait monter au plafond les spécialistes mais j'attend de finir mon projet avant de passer a la phase d'optimisation.
C'est peut-être pas la meilleur manière, mais je préfère d'abord poser la structure que j'ai en tête avant d'oublier ou m’embrouiller et seulement ensuite j'essaye d'améliorer.
Tout ça pour te dire merci pour l'indication et que je viendrais surement vous embêter plus tard.
Une fois que je me serais documenté bien sur.
22/01/2019, 15h33
MarcelG

Je ne comprends pas l'erreur.

Juste avant la boucle tu peux tester

Code:

Debug.Print Range("M3:M" & iRow).Specialcells(xlCellTypeBlanks).Count

Citation:

Et je ne veux surtout pas la solution, il faut que j'apprenne.

Citation:

Je sais bien que mes lignes de code ferait monter au plafond les spécialistes mais j'attend de finir mon projet avant de passer a la phase d'optimisation

Bravo pour ta ligne de conduite.:ccool:
C'est la recherche qui fait progresser.
En cas d'échec, le Forum est là pour apporter son aide. Je suis passé par là, et j'étais bien content de trouver les Ouskelnor et autres mercatog.

Bonne continuation et à bientôt j'espère.
22/01/2019, 15h51
halaster08
Ne comprenant pas l'erreur moi non plus, j'ai testé sur une feuille complètement vide ceci:
Code:

1 2 3 4 5 6 Sub test() For Each cel In Range("M3:M10").SpecialCells(xlCellTypeBlanks) texte = texte & cel.Address & " - " Next cel MsgBox texte End Sub
Erreur 1004 aucune cellule correspondante

puis ceci:
Code:

1 2 3 4 5 6 7 Sub test() Range("m4") = "" For Each cel In Range("M3:M10").SpecialCells(xlCellTypeBlanks) texte = texte & cel.Address & " - " Next cel MsgBox texte End Sub
il trouve m3 et m4

et enfin
Code:

1 2 3 4 5 6 7 Sub test() Range("a10") = 1 For Each cel In Range("M3:M10").SpecialCells(xlCellTypeBlanks) texte = texte & cel.Address & " - " Next cel MsgBox texte End Sub
il trouve de m3 à m9

Conclusion: le SpecialCells semble faire une intersection implicite avec le UsedRange

@minifrix
Dans ton code, tu ne précise pas sur quelle feuille tu travailles, donc il le fait sur la feuille active, quelle était ta feuille active au moment de l'erreur ? était-elle vide ?
22/01/2019, 16h59
MarcelG

Salut Halaster et merci pour cette contribution. :plusser:

J'ai également remarqué cette "anomalie"
Au début, j'ai bien l'erreur 1004.
Mais si, après plusieurs tests,
Je place une valeur intermédiaire dans le champ
J'efface cette valeur (voire je supprime la ligne)
J'élargis le champ de test (de 20 lignes)
La propriété retourne la même adresse (exemple D28:D30) alors que les cellules sont vides de D31 à D50.:calim2:
22/01/2019, 20h47
minifrix

Citation:

Envoyé par halaster08

@minifrix
Dans ton code, tu ne précise pas sur quelle feuille tu travailles, donc il le fait sur la feuille active, quelle était ta feuille active au moment de l'erreur ? était-elle vide ?

Oui, je travaille sur la feuille active (Listing) et elle comprend un tableau rempli de 17 colonnes et environs 43 lignes pour le moment.
Ce code est placé dans mon "ThisWorkBook" pour qu'il me signale les manques à l'ouverture.

Ah, on sent bien que quand y en a qui tombe sur un os, ça ronge, ça ronge !:aie:
23/01/2019, 09h27
halaster08
Peut être que ta feuille active n'est pas la bonne a l'ouverture du classeur
Essaye d'activer la feuille au début du code:
Code:

1 2 3 4 Private Sub workbook_open() Sheets("Listing").Activate 'ton code End Sub
Ou de préciser de préciser devant chaque objet de type range la feuille correspondante.
23/01/2019, 10h44
MarcelG

Personnellement, je préfère la 2ème solution.

La rigueur oblige à bien rattacher les objets.

Sauf pour gérer une interface utilisateur, l'activation d'une feuille de travail est rarement nécessaire pour y affecter méthodes et propriétés.

Citation:

Envoyé par halaster08

Peut être que ta feuille active n'est pas la bonne a l'ouverture du classeur
Essaye d'activer la feuille au début du code:

Code:

1
2
3
4
Private Sub workbook_open()
Sheets("Listing").Activate
'ton code
End Sub

Ou de préciser de préciser devant chaque objet de type range la feuille correspondante.

Ma feuille étant la seule à être appelée, je pense que par défaut elles active.
Voici mon le démarrage de mon "ThisWorkBook"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub Workbook_Open()
Application.ScreenUpdating = False
With Application
.DisplayFullScreen = True
.DisplayStatusBar = False
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayWorkbookTabs = False
.DisplayHeadings = False
.DisplayVerticalScrollBar = True
End With
ActiveSheet.Unprotect
Sheets("Listing").Select
Sheets("Listing").ScrollArea = "A1:Q80"
Range("A:Q").Select
ActiveWindow.Zoom = True
Range("K3").Select
ActiveSheet.Protect
Call arobase
Application.ScreenUpdating = True
Dim Cel As Range, iRow&, Périmés$, Certificat$, Règlement$
iRow = Range("L" & Rows.Count).End(xlUp).Row
For Each Cel In Range("L3:L" & iRow)
If Len(Cel) > 0 Then
    If Date >= DateAdd("yyyy", 3, Cel.Value) Then
         Périmés = Périmés & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf
    End If
End If
Next
 MsgBox "Le certificat des personnes suivantes est périmé :" & vbCrLf & Périmés, vbExclamation, "Certificat Médical"
iRow = Range("M" & Rows.Count).End(xlUp).Row
For Each Cel In Range("M3:M" & iRow)
   If Cel.Value = "" Then
         Certificat = Certificat & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf
    End If
Next
MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat"
iRow = Range("N" & Rows.Count).End(xlUp).Row
For Each Cel In Range("N3:N" & iRow)
If Cel.Value = "" Then
         Règlement = Règlement & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf
  End If
Next
MsgBox "Le règlement des personnes suivantes est attendu :" & vbCrLf & Règlement, vbExclamation, "Règlement"
End Sub

23/01/2019, 13h24
Patrice740

Bonjour,

Citation:

Envoyé par minifrix

Et je ne veux surtout pas la solution, il faut que j'apprenne.
Je sais bien que mes lignes de code ferait monter au plafond les spécialistes mais j'attend de finir mon projet avant de passer a la phase d'optimisation.

Sans parler de véritable optimisation, il faut essayer dès le début d'écrire un code propre.
Première étape : écris ton code sans utiliser .Select (inutiles dans ton cas)
23/01/2019, 14h16
minifrix

Merci.

Personnellement comme j'apprend doucement, pour une fonction j'ai une syntaxe de code en tête et du coup :
je la pose, je vérifie si pas d'erreur et ensuite je passe a la suivante.
Mais tout ça sans prendre en compte l'ensemble.
D’où des lignes horribles pour les spécialistes :D et l'obligation pour moi de passer à la fin par un stade de re-lecture et d'amélioration.
23/01/2019, 15h30
Patrice740

Citation:

Envoyé par minifrix

Personnellement comme j'apprend doucement, pour une fonction j'ai une syntaxe de code en tête et du coup :
je la pose, je vérifie si pas d'erreur et ensuite je passe a la suivante..

Lorsqu'elles sont basiques, il faut prendre les bonnes habitudes dès le début, ça évites de très nombreux déboires à venir.
Les 2 premières :
- Commencer tous les modules par Option Explicit (Outils/Options/Editeur, cocher Déclaration des variables obligatoires)
- Ne jamais utiliser Select.
23/01/2019, 19h05
minifrix

Merci, j'en prend note.

Bonsoir,

Mon projet est enfin posé. Ouf
Forcément au niveau écriture de code, c'est encore moche mais fonctionnel.
Je commence donc la relecture et l'amélioration par mon ThisWorkBook :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 Private Sub Workbook_Open() Application.ScreenUpdating = False With Application .DisplayFullScreen = True .DisplayStatusBar = False .DisplayFormulaBar = False End With With ActiveWindow .DisplayWorkbookTabs = False .DisplayHeadings = False .DisplayVerticalScrollBar = True End With ActiveSheet.ScrollArea = "A1:Q80" Call Arobase ActiveSheet.Protect Application.ScreenUpdating = True Dim Cel As Range, iRow&, Périmés$, Certificat$, Règlement$ iRow = Range("L" & Rows.Count).End(xlUp).Row For Each Cel In Range("L3:L" & iRow) If Len(Cel) > 0 Then If Date >= DateAdd("yyyy", 3, Cel.Value) Then Périmés = Périmés & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf End If End If Next MsgBox "Le certificat des personnes suivantes est périmé :" & vbCrLf & Périmés, vbExclamation, "Certificat Médical" iRow = Range("M" & Rows.Count).End(xlUp).Row For Each Cel In Range("M3:M" & iRow) If Cel.Value = "" Then Certificat = Certificat & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf End If Next MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat" iRow = Range("N" & Rows.Count).End(xlUp).Row For Each Cel In Range("N3:N" & iRow) If Cel.Value = "" Then Règlement = Règlement & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf End If Next MsgBox "Le règlement des personnes suivantes est attendu :" & vbCrLf & Règlement, vbExclamation, "Règlement" End Sub
Pour résoudre mon problème (j'en suis pas fier, un peu de jugeote et j'aurais fait gagner du temps à tout le monde) au moment de l'écriture, j'ai appliqué le bon conseil :
Citation:
Envoyé par halaster08
Bonjour,

Il te suffit de sortir le msgbox de ta boucle:
Code:

1 2 3 4 5 6 7 8 9 Dim Cel As Range, iRow&, Certificat$, iRow = Range("M" & Rows.Count).End(xlUp).Row For Each Cel In Range("M3:M" & iRow) If Cel.Value = "" Then Certificat = Certificat & vbTab & Application.Proper(Cells(Cel.Row, "B")) & " " & UCase(Cells(Cel.Row, "C")) & " " & Application.Proper(Cells(Cel.Row, "D")) & vbCrLf End If Next MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat"
Alors effectivement, au moment de la création, j'avais laissé des cellule vides pour tester la fonction et dans ce cas ça marche.
Mais en relisant et en testant, le fait d'avoir sortie de la boucle mon Message Box, fait que même si toutes les cellules sont remplies, d'être après mon Next il me fait apparaître ce Message Box.
Je me dis facile, je place un If..... Euh où ? , je le remet dans la boucle et je rajoute une condition.... Euh mon 1er problème est de retour, je vais mettre un GoTO....Euh non ça il faut pas !
Résultat, je reviens vers vous en rampant :oops:.
Sil vous plait, auriez vous la gentillesse et la patiente de m'aiguiller ?
Par avance merci et encore désolé.

26/01/2019, 10h39
halaster08

Si tu n'as pas de case vide, ta variable Certificat est normalement vide aussi, du coup il te suffit de tester sa longueur pour savoir si tu dois afficher la messagebox ou pas

Code:

if len(Certificat )>0 then msgbox ...

re
ou !! initialiser une variable compteur

Code:

1
2
3
4
5
6
7
8
9
10
11
Dim Cel As Range, iRow&, Certificat$,x& 
'tu devrais  precisé le sheet parent (au moins activesheet )
with sheet("toto")
iRow = .Range("M" & Rows.Count).End(xlUp).Row
For Each Cel In .Range("M3:M" & iRow)If Cel.Value = "" Then
         x=x+1
Certificat = Certificat & vbTab & Application.Proper(.Cells(Cel.Row, "B")) & " " & UCase(.Cells(Cel.Row, "C")) & " " & Application.Proper(.Cells(Cel.Row, "D")) & vbCrLf
    End If
Next
end with
if x>0 then MsgBox "Le certificat des personnes suivantes est attendu :" & vbCrLf & Certificat, vbExclamation, "Certificat"

2 pièce(s) jointe(s)

avis personnels

Bonjour,

@Patrice, dans «Ne jamais utiliser Select.»,le "jamais" me semble excessif ;).
Je dirais plutôt, «N'utiliser "Select" qu'à bon escient !»
Tant qu'à choisir entre "Feuil1.Select" et "Feuil1.Activate", je ne me pose pas la question, je choisis l'expression la plus courte.
Par contre, je remplacerais "Feuil1.Select" suivi de "[B36000].Select" par "Application.Goto Feuil1.[B36000], … " (,0 ou 1).
Je suis d'accord avec toi quand tu annonces :
«Sans parler de véritable optimisation, il faut essayer dès le début d'écrire un code propre.».
Je rajouterais que le Raisonnement se doit de précéder l'écriture.

@Patrick, le "WITH Feuil1…End With" qui permet d'éviter dans ce cas le Select, ne donne pas la possibilité de voir les effets quand on n'est pas sur l'onglet cité.

@minifrix , je suis toujours apprenant et j'acquiers des bases surtout en étudiant les codes proposés.
Je ne rejette jamais une option que je domine mal et qui, dans mon apprentissage, me fait faire des bêtises.
Je tiens compte du fait d'une d'entre elles peut être ou pas défaillante selon le contexte.

J'ai constaté que nommer des objets facilite grandement les choses (formules et VBA).
Ici, par exemple, la plage des certificats étant nommée "Certificat", je passerais par
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub Workbook_Open() Dim R As Range, C$, N$, P$, Manque$, Oups$ Feuil1.Select 'peut-être pas utile (?) For Each R In [Certif] C = Application.Proper(R(1, -10)) & vbTab N = UCase(R(1, -9)) & " " '1 : même ligne, -9 : neuf lignes à gauche(-) P = Application.Proper(R(1, -8)) & vbLf If R = "" Then Manque = Manque & C & N & P If R <> "" And R < Date Then Oups = Oups & C & N & P Next If Manque <> "" Then Manque = "Le Certificat des personnes suivantes manque :" & vbLf & Manque If Oups <> "" Then Oups = "Celui des personnes suivantes est périmé :" & vbLf & Oups MsgBox Manque & vbLf & Oups, , "Attention..." End Sub
mais, ici, cela ne me satisfait pas : l'affichage peut prêter à confusion avec la multiplication des trous.
En essayant de trouver une autre voie, je passe par des plages filtrées (aspects gardés) sachant que
l'utilisation de l'outil Tableau (dans un onglet) apporte de très nombreux avantages !

Le tableau de la plage concernée étant nommée Tbo, on peut utiliser la procédure
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub Workbook_Open() Private Sub Workbook_Open() [Tbo].AutoFilter 12, "=" If [Tbo].SpecialCells(12).Count > 0 Then MsgBox "certificats oubliés ", , "Attention..." End If [Tbo].NumberFormat = "General" 'un filtre avec des Dates n'est pas toujours simple à programmer. [Tbo].AutoFilter 12, "<" & CDbl(Date) If [Tbo].SpecialCells(12).Count > 0 Then MsgBox "certificats périmés ", , "Attention..." End If [Tbo].AutoFilter: [Tbo].NumberFormat = "dd/mm/yyyy" End Sub
Maintenant, on peut alerter autrement et sans macro : avec des mises en forme conditionnelles !

Voir 40 message(s) de cette discussion en une page