Discussion :

[minifrix]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[halaster08]

Bonjour,

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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"

[minifrix]

Merci.
C’était tellement simple et logique
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.

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[minifrix]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[MarcelG]

Je ne comprends pas l'erreur.

Juste avant la boucle tu peux tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Bravo pour ta ligne de conduite.
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.

[Patrice740]

Bonjour,

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)

[minifrix]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Bonjour,


Il te suffit de sortir le msgbox de ta boucle:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 .
Sil vous plait, auriez vous la gentillesse et la patiente de m'aiguiller ?
Par avance merci et encore désolé.

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

re
ou !! initialiser une variable compteur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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"

[OrDonc]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

[minifrix]

re
ou !! initialiser une variable compteur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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"

Bon, j'ai choisi cette solution.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
Private Sub Workbook_Open()
Application.ScreenUpdating = False
With Application
.DisplayFullScreen = True
.DisplayStatusBar = False
.DisplayFormulaBar = False
.OnKey "{ESCAPE}", ""
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$, L&, Certificat$, x&, Règlement$, k&
iRow = Range("L" & Rows.Count).End(xlUp).Row
With ActiveSheet
For Each Cel In Range("L3:L" & iRow)
If Len(Cel) > 0 Then
    If Date >= DateAdd("yyyy", 3, Cel.Value) Then
    L = L + 1
         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
End With
If L > 0 Then MsgBox "Le certificat des personnes suivantes est périmé :" & vbCrLf & Périmés, vbExclamation, "Certificat Médical"
With ActiveSheet
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"
With ActiveSheet
iRow = .Range("N" & Rows.Count).End(xlUp).Row
For Each Cel In .Range("N3:N" & iRow)
If Cel.Value = "" Then
         k = k + 1
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
End With
If k > 0 Then MsgBox "Le Règlement des personnes suivantes est attendu :" & vbCrLf & Règlement, vbExclamation, "Règlement"
End Sub

Simple et efficace, mes 3 MessageBox apparaissent quand-il le faut et comme il faut.

Merci à vous tous pour vos aides précieuse .