Résolu problème test VBA et affichage

estivill

XLDnaute Nouveau
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
 

Fichiers joints

estivill

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
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.
 

Fichiers joints

estivill

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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 ;)
 

Staple1600

XLDnaute Barbatruc
Re

Oui, en tout cas dans Excel 2013 ;)
(Pour être franc et précis: plusieurs écrans se sont succèdes)

Sinon pour la question et cette histoire d’échéance, pourquoi passer par les formules?
 

estivill

XLDnaute Nouveau
salut,
c'est afin de tester la date du jour et les différentes dates d'échéances afin d'afficher le message approprié

alerter 2 mois / 1 mois / échéance dépassé
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas