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
 

Pièces jointes

  • Suivi sécurité - SP - 5.0 mise en ligne.xlsm
    320.8 KB · Affichages: 3

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.
 

Pièces jointes

  • Suivi sécurité - SP - 5.0 mise en ligne.xlsm
    321.4 KB · Affichages: 5

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

Discussions similaires

Réponses
6
Affichages
202
Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal