problème test VBA et affichage

[estivill]

bonjour,
je viens vers vous car je trouve pas ce qui cloche dans mon test.....
je souhaite tester la date d'aujourd'hui et afficher dans une message box si la date est plus grande qu'un seuil d'alerte "equipement en echeance dans moins de 2 mois" ou autre

Sub echeances()

Dim txt As String
txt = ""
For i = 2 To Worksheets.Count
Worksheets(i).Range("O6").FormulaLocal = "=AUJOURDHUI()"
For j = 9 To Range("T" & Rows.Count).End(xlUp).Row
If Worksheets(i).Range("O" & j) > Worksheets(i).Range("O6") > Worksheets(i).Range("J" & j) Then
If Worksheets(i).Range("E" & j) > Worksheets(i).Range("O6") > Worksheets(i).Range("O" & j) Then
If Worksheets(i).Range("E" & j) < Worksheets(i).Range("O6") Then
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("B" & j) & " expirée." & vbCrLf
Else
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("B" & j) & " expire moins de 2 mois." & vbCrLf
End If
Else
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("B" & j) & " expire moins de 3 mois." & vbCrLf
End If
End If
Next j
Next i
MsgBox txt, , " ----- VISITES A PREVOIR ------" 'afficher la msgbox
'
End Sub

je vous ai joint mon fichier excel
merci d'avance pour le temps que vous allez m'accorder

 

[sylvanu]

Bonsoir Estivii,
La notation a>b>c n'existe pas en VBA.
Utilisez a>b and b>c .

 

[estivill]

bonsoir,
c'est fait merci je ne savais pas que ce test ne fonctionnait pas

If Worksheets(i).Range("O" & j) > Worksheets(i).Range("O6") And Worksheets(i).Range("O6") > Worksheets(i).Range("J" & j) Then
If Worksheets(i).Range("E" & j) > Worksheets(i).Range("O6") And Worksheets(i).Range("O6") > Worksheets(i).Range("O" & j) Then
If Worksheets(i).Range("E" & j) < Worksheets(i).Range("O6") Then

malheureusement ma msg box reste vide .....

 

[sylvanu]

Plusieurs problèmes :
1- Worsheet(i) ne mène nulle part car Sheets.Count donne le nombre de feuille mais sheet(i) ne mene pas sur la feuille 1. Il faut passer par le nom de la feuille pour faire simple :
Nom = Sheets(i).Name puis Worksheets(Nom) ( je l'ai rectifié )
2- Votre msgbox ne peut être que vide.
Toutes vos dates sont 1900 ou 2010 et vous cherchez SI Date>aujourd'hui, donc il ne répond rien.
Comme je ne sais pas ce que vous voulez faire, en PJ juste la rectification et a>b>c et des nom feuilles.
J'ai mis un message d'alerte si aucun test n'est positif. Evidemment à supprimer quand tout marchera.

 

[estivill]

le but est de suivre les équipements de plusieurs bâtiments,
1 feuille par bâtiments
la feuille VIERGE est la feuille type
les tests s'effectuent sur les feuilles portant les noms des bâtiments d'où le Worsheet(i) qui commence à partie de i=2

 

[sylvanu]

Je répondais à votre question : Pourquoi ma msgbox est vide ?
Parce que les données présentes dans la feuilles ne sont pas bonnes.
Donc pour tester votre macro il faut remplir les dates correctement afin d'obtenir un msgbox non vide.
Si vous avez un fichier avec des feuilles remplies, pourquoi donc avoir fourni que la page vierge. Comment aurais je pu deviner ?

 

[estivill]

oui j'ai sans doute mal expliqué ma problématique

j'ai mis un fichier vierge simplement pour eviter de saturer d'informations inutile

 

[estivill]

ENFAIT JE SUIS UN BOULET mdr

j'avais oublier de modifier mon code en lui indiquant la nouvelle colonne où trouver le debutde l'info de la ms box

pour info

Private Sub Workbook_Open()
Dim txt As String
txt = ""
For i = 2 To Worksheets.Count
Worksheets(i).Range("O6").FormulaLocal = "=AUJOURDHUI()"
For j = 9 To Range("T" & Rows.Count).End(xlUp).Row
If Worksheets(i).Range("O" & j) < Worksheets(i).Range("O6") And Worksheets(i).Range("O6") < Worksheets(i).Range("E" & j) Then
If Worksheets(i).Range("j" & j) < Worksheets(i).Range("O6") And Worksheets(i).Range("O6") < Worksheets(i).Range("O" & j) Then
If Worksheets(i).Range("E" & j) < Worksheets(i).Range("O6") Then
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expirée." & vbCrLf
Else
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expire moins de 2 mois." & vbCrLf
End If
Else
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expire moins de 3 mois." & vbCrLf
End If
End If
Next j
Next i
MsgBox txt, , " ----- VISITES A PREVOIR ------" 'afficher la msgbox
'
End Sub

 

[estivill]

reste un problème, les différents tests qui bug

 

[sylvanu]

YaPuKa faire la mise au point.
Une macro commence toujours par un bug, et finit souvent par un bug. 🙂

 

[estivill]

effectivement et souvent changer de point de vue permet de les résoudre 😉
c'était la cascade des if

si ça peut servir au prochain en galère:

If Worksheets(i).Range("O6") > Worksheets(i).Range("E" & j) Then
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expirée." & vbCrLf
Else
If Worksheets(i).Range("O" & j) < Worksheets(i).Range("O6") And Worksheets(i).Range("O6") < Worksheets(i).Range("E" & j) Then
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expire moins de 1 mois." & vbCrLf
Else
If Worksheets(i).Range("j" & j) < Worksheets(i).Range("O6") And Worksheets(i).Range("O6") < Worksheets(i).Range("O" & j) Then
txt = txt & Worksheets(i).Name & " échéance " & Worksheets(i).Range("S" & j) & " expire moins de 3 mois." & vbCrLf
Else
End If
End If
End If


content d'avoir trouver ça me prendra pas la tête ce weekend

et merci pour ton aide et ton temps

 

[Staple1600]

Bonsoir le fil, estivill, sylvanu

YaPuKa faire la mise au point.
Une macro commence toujours par un bug, et finit souvent par un bug. 🙂

Je ne comprends pas cette affirmation

Sub Macro()
MsgBox Date
End Sub

Où donc est le "primo-bug"?

 

[sylvanu]

Bonsoir Staple,
C'était uniquement pour des gens comme moi qui n'ont pas votre niveau.🙂

 

[Staple1600]

Re

Je n'ai aucun niveau.
Comme je l'ai dit dans un autre fil.
Tout n'est qu'une question de temps passé devant un écran sur lequel s'affichait Excel 😉
Il se trouve juste que mon écran est allumé depuis Excel 4 😉

 

[sylvanu]

Ctrl + F11. Ca marche toujours !