Pb dans ordre de déroulement étapes script VB

Bonjour,

Sans rentrer dans le détail de ta macro, il me semble que c'est écrit en clair dans les commentaires :

'si rien n'est trouver, quitter la procédure
If celluleRecherche Is Nothing Then Exit Sub

;o)

Bjr,

le pb que tu as repéré doit etre a la base de ce qui m'embete...je n'avais pas fais attention entre tt !

Code :
'si rien n'est trouver, quitter la procédure
If celluleRecherche Is Nothing Then Exit Sub

le souci c'est que j'ai essayé en enlevant la commande tout betement mais ca ne marche pas...meme en rajoutant un "set" ici:

Code :
lAdressePremCell = celluleRecherche.Address

ce ne marche pas........et je ne sais pas comment modifier mon script...

En fait tu parcours 3 colonnes si j'ai bien compris, je ferai comme ça :

Dim texteCherche As String, message As String
Dim plage As Range
Dim derLig As Long
Dim cel

'initialiser le texte à chercher ("s24" si on est en semaine 22) 
texteCherche = "s" & CStr(Module1.Semaine(Now) + 2) 

message = "Ne pas oublier d'envoyer le courrier afin d'annoncer le début des travaux :" & vbNewLine 

'Recherche sur la première colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("H65536").End(xlUp).Row

Set plage = Range("H1:H" & derLig)

For Each cl In Plage
   If InStr(1, cl.Value, texteCherche) <> 0 Then
      'ajouter une ligne au message 
       message = message & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) &  _
       ", " &   cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """" 
   End If
Next cl

Set plage = Nothing

'Recherche sur la deuxième colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("J65536").End(xlUp).Row

Set plage = Range("J1:J" & derLig)

For Each cl In Plage
   If InStr(1, cl.Value, texteCherche) <> 0 Then
      'ajouter une ligne au message 
       message = message & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) &  _
       ", " &   cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """" 
   End If
Next cl

Set plage = Nothing

'Recherche sur la troisième colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("K65536").End(xlUp).Row

Set plage = Range("K1:K" & derLig)

For Each cl In Plage
   If InStr(1, cl.Value, texteCherche) <> 0 Then
      'ajouter une ligne au message 
       message = message & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) &  _
       ", " &   cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """" 
   End If
Next cl

Set plage = Nothing

MsgBox message

J'ai fait ça de tête sans tester, il doit falloir certainement faire des corrections. J'ai pris les colonnes H, J et K à tester, qu'il faut adapter à ton fichier.

Les colonnes sont testées, pour chaque cellule d'une colonne on teste (InStr()) si le texte recherché est contenu dans la cellule, si oui, on le mémorise dans "message".

;o)

oula!.....je ss impressionné...

mais je dois faire ca 3 fois (car j'ai différentes conditions...pr chacune des 3 colonnes) et que j'ai galéré pr que mon script marche.........

aurais tu une solution pr que le script en place fonctionne ?! ca doit pas etre compliqué mais je ne sais pas comment faire ?
par contre je vais qd mm essayer ce que tu m'as fait car c'est tellement beau que ca mérite d'être essayé !!

En ayant mis ton script et en l'ayant modifié...rien ne se passe...alors qu'on est en semaine 24 et que mes colonnes H et I contiennent des lignes avec s24....pas de pop up !

Slt nico,

merci d'etre encore la!!

pr le script, en fait comme je l'ai dis dans l'autre fil, tt va bien mais il s'arrete des lors que la 1ere des 3 phases n'est pas vérifiée a cause de cette commande probablement:

If celluleRecherche Is Nothing Then Exit Sub

mais je ne sais pas comment modifier le script pr me passer de cette commande!

oups un pb de post dsl ;-)

par contre je ss en train de retester ton code avec toutes les modifs a apporter...

a priori ton script marche sans marcher....
un pop up apparait avec :
"Ne pas oublier d'envoyer le courrier afin d'annoncer le début des travaux "

mais ne m'indique pas ttes les infos qu'il faut comme ce code la devrait faire :

Set plage = Range("H1:H" & derLig)

For Each cl In plage
If InStr(1, cl.Value, texteCherche) <> 0 Then
'ajouter une ligne au message
message = message & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) & _
", " & cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """"
End If
Next cl

Set plage = Nothing

par ailleurs l'info concernant la colonne I ne s'affiche pas alors que les conditions sont remplies!

PS: je ne vois pas où dans le script les conditions du genre: (pop up si num de semaine dans colonne I = num de semaine actuel) se trouve........

Voila ce que donne le script que tu m'as proposé modifié....

Option Explicit

Private Sub Workbook_Open()

Dim texteCherche As String, message As String, messageL As String, messageFINTX As String, texteChercheS As String
Dim plage As Range
Dim derLig As Long
Dim cl

'initialiser le texte à chercher ("s24" si on est en semaine 22)
texteCherche = "s" & CStr(Module1.Semaine(Now) + 2)
texteChercheS = "s" & CStr(Module1.Semaine(Now))

message = "Ne pas oublier d'envoyer le courrier afin d'annoncer le début des travaux :" & vbNewLine
messageL = "Evelyne penses à régulariser la situation n°2 pour :" & vbNewLine
messageFINTX = "Evelyne penses à régulariser la situation n°3 pour :" & vbNewLine

'Recherche sur la première colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("H65536").End(xlUp).Row

Set plage = Range("H1:H" & derLig)

For Each cl In plage
If InStr(1, cl.Value, texteCherche) <> 0 Then
'ajouter une ligne au message
message = message & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) & _
", " & cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """"
End If
Next cl

Set plage = Nothing

'Recherche sur la deuxième colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("H65536").End(xlUp).Row

Set plage = Range("H1:H" & derLig)

For Each cl In plage
If InStr(1, cl.Value, texteChercheS) <> 0 Then
'ajouter une ligne au message
messageL = messageL & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -7) & ", " & _
cl.Offset(0, -5) & ", " & cl.Offset(0, -4) & """"
End If
Next cl

Set plage = Nothing

'Recherche sur la troisième colonne
derLig = ThisWorkbook.Sheets("Feuil1").Range("I65536").End(xlUp).Row

Set plage = Range("I1:I" & derLig)

For Each cl In plage
If InStr(1, cl.Value, texteChercheS) <> 0 Then
'ajouter une ligne au message
messageFINTX = messageFINTX & vbNewLine & vbNewLine & "Chantier """ & cl.Offset(0, -8) & ", " & _
cl.Offset(0, -6) & ", " & cl.Offset(0, -5) & """"
End If
Next cl

Set plage = Nothing

MsgBox message

End Sub

Sinon voici le code en place que j'aimerais conserver si possible, mais modifié pr qu'il s'exécute en entier qq soit les réponses aux critères des différentes étapes....

Option Explicit

Private Sub Workbook_Open()

Dim texteCherche As String, message As String, celluleRecherche As Range, zoneRecherche As Range, lAdressePremCell As String

'initialiser le texte à chercher ("s24" si on est en semaine 22)
texteCherche = "s" & CStr(Module1.Semaine(Now) + 2)

'initialiser la zone de recherche (colonne H)
Set zoneRecherche = ThisWorkbook.Sheets("Feuil1").Range("H:H")

message = "Ne pas oublier d'envoyer le courrier afin d'annoncer le début des travaux :" & vbNewLine

'lancer la recherche
Set celluleRecherche = zoneRecherche.Find(texteCherche, , xlValues, xlWhole)
'si rien n'est trouver, quitter la procédure
If celluleRecherche Is Nothing Then Exit Sub
'sinon, mémoriser l'adresse de la première cellule trouvée
lAdressePremCell = celluleRecherche.Address
'boucler ...
Do
'traiter la cellule de recherche

'ajouter une ligne au message
message = message & vbNewLine & vbNewLine & "Chantier """ & celluleRecherche.Offset(0, -7) & ", " & _
celluleRecherche.Offset(0, -5) & ", " & celluleRecherche.Offset(0, -4) & """"

'rechercher la cellule suivante
Set celluleRecherche = zoneRecherche.FindNext(celluleRecherche)
'... tant que la cellule de recherche n'est pas revenu à la première cellule trouvée
Loop Until celluleRecherche.Address = lAdressePremCell
Set celluleRecherche = Nothing

MsgBox message

' ---------------------------------------------------------------------------------------------

Dim texteChercheL As String, messageL As String, celluleRechercheL As Range, zoneRechercheL As Range, lAdressePremCellL As String

'initialiser le texte à chercher ("s24" si on est en semaine 22)
texteChercheL = "s" & CStr(Module1.Semaine(Now))

'initialiser la zone de recherche (colonne F)
Set zoneRechercheL = ThisWorkbook.Sheets("Feuil1").Range("H:H")

messageL = "Evelyne penses à régulariser la situation n°2 pour :" & vbNewLine

'lancer la recherche
Set celluleRechercheL = zoneRechercheL.Find(texteChercheL, , xlValues, xlWhole)
'si rien n'est trouver, quitter la procédure
If celluleRechercheL Is Nothing Then Exit Sub
'sinon, mémoriser l'adresse de la première cellule trouvée
lAdressePremCellL = celluleRechercheL.Address
'boucler ...
Do
'traiter la cellule de recherche

'ajouter une ligne au message
messageL = messageL & vbNewLine & vbNewLine & "Chantier """ & celluleRechercheL.Offset(0, -7) & ", " & _
celluleRechercheL.Offset(0, -5) & ", " & celluleRechercheL.Offset(0, -4) & """"

'rechercher la cellule suivante
Set celluleRechercheL = zoneRechercheL.FindNext(celluleRechercheL)
'... tant que la cellule de recherche n'est pas revenu à la première cellule trouvée
Loop Until celluleRechercheL.Address = lAdressePremCellL
Set celluleRechercheL = Nothing

MsgBox messageL

' --------------------------------------------------------------------------------------------

Dim texteChercheFINTX As String, messageFINTX As String, celluleRechercheFINTX As Range, zoneRechercheFINTX As Range, lAdressePremCellFINTX As String

'initialiser le texte à chercher ("s24" si on est en semaine 22)
texteChercheFINTX = "s" & CStr(Module1.Semaine(Now))

'initialiser la zone de recherche (colonne F)
Set zoneRechercheFINTX = ThisWorkbook.Sheets("Feuil1").Range("I:I")

messageFINTX = "Evelyne penses à régulariser la situation n°3 pour :" & vbNewLine

'lancer la recherche
Set celluleRechercheFINTX = zoneRechercheFINTX.Find(texteChercheFINTX, , xlValues, xlWhole)
'si rien n'est trouver, quitter la procédure
If celluleRechercheFINTX Is Nothing Then Exit Sub
'sinon, mémoriser l'adresse de la première cellule trouvée
lAdressePremCellFINTX = celluleRechercheFINTX.Address
'boucler ...
Do
'traiter la cellule de recherche

'ajouter une ligne au message
messageFINTX = messageFINTX & vbNewLine & vbNewLine & "Chantier """ & celluleRechercheFINTX.Offset(0, -8) & ", " & _
celluleRechercheFINTX.Offset(0, -6) & ", " & celluleRechercheFINTX.Offset(0, -5) & """"

'rechercher la cellule suivante
Set celluleRechercheFINTX = zoneRechercheFINTX.FindNext(celluleRechercheFINTX)
'... tant que la cellule de recherche n'est pas revenu à la première cellule trouvée
Loop Until celluleRechercheFINTX.Address = lAdressePremCellFINTX
Set celluleRechercheFINTX = Nothing

MsgBox messageFINTX

End Sub

ok pb résolu.......

la solution:

mettre ca

If celluleRecherche Is Nothing Then
'ON FAIT RIEN
Else

et rajouter un End If a la fin........

Merci a NicoDisso pr la solution ;-) et aux autres pour s'être penchés sur mon problèmes!!

Tu veux le message à chaque fois que la condition est remplie ?

Dans ce cas, il faut mettre le msgBox dans le If InStr(...) Then ...

Pour l'affichage des infos, puisque tes colonnes à tester ne changent pas, pourquoi utiliser OffSet ? en récupérant le numéro de ligne, on peut répurérer les cellules qui vont bien ...

Je j'ajouterai ca:

Dim lig as long

'.....

For Each cl In plage
If InStr(1, cl.Value, texteCherche) <> 0 Then
'Récupération du numéro de ligne
lig = cl.Row
'ajouter une ligne au message
message = message & vbNewLine & vbNewLine & "Chantier """ & ThisWorkbook.Sheets("Feuil1").Range("B" & lig).Value & _
", " & ThisWorkbook.Sheets("Feuil1").Range("D" & lig).Value & ", " & ThisWorkbook.Sheets("Feuil1").Range("E" & lig).Value & """"

'ici pour avoir le pop up dès la condition trouvée
MsgBox message
End If

Next cl
'Ici pour avoir le pop up un fois toute la colonne testée
MsgBox message

'.....

Re Polux31, en fait le message (différent pr chaque condition) devait s'afficher a chaque fois que la condition en question etait remplie, et ceux quelque soit la colonne concernée..

de fait avec mon post précédent tt marche super, mais je ss content car ton script me permet de voir une facon différente de cerner le problème, avec une facon de programmer personnelle.....et ca c"est enrichissant!

merci bcp de t'etre penché sur mon pb en tt cas...

Bonne aprés midi, a bientot sur CCM !