Aide:Prob. dans mon code VBA

[Vinvinsylvain]

Bonjour a tous!!!!!!


Voici mon code qui permet de recherche

Dim countTot As Long
Dim counter As Long
Dim strSearchString As String
Dim Ws As Object
Dim foundCell As Variant
Dim loopAddr As Variant
Dim returnValue As String
Dim strSearchString1 As String
Dim MyCollection As String

strSearchString = TxtNomVol.Value
strSearchString1 = TxtPrénomVol.Value

If strSearchString1 = '' Then strSearchString = '' Else


For Each Ws In Worksheets
countTot = countTot + Application.CountIf(Ws.UsedRange, '=' & strSearchString)
Next Ws
If countTot = 0 Then
returnValue = MsgBox(' Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' n'est pas connue de nos fichiers ', vbOKOnly, ' Message ')
Else
counter = 0
For Each Ws In Worksheets
With Ws
.Activate
Set foundCell = .Cells.Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
loopAddr = foundCell.Address
Do
counter = counter + 1
foundCell.Activate
If countTot = 2 Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' EST CONNUE DE NOS SERVICE, veuillez continué le constat de vol et intérroger le Récap. Interpelle ', vbOKOnly, ' Message ')
Exit Sub
End If
If counter = countTot Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' sélectionnée est la dernière !', vbOKOnly, 'Message')
Exit Sub
Else
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' a été ' & countTot & vbLf)
If returnValue = vbNo Then Exit For
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr
End If
End With
Next Ws
End If




Mon probleme s'est qu'il recherche la valeur (TxtNomVol et TxtPrénomVol) dans tous le classeur, j'aimerai qu'il recherche seulement dans la feuille RéCap. comment je peut fair.
Merci de Votre aide

 

[Hervé]

Bonjour vinvin, le forum



j'ai pas de solution à ton souci, mais je suis resté sur ma faim sur ce post :

Ce lien n'existe plus

Donc, si tu pouvais me dire ou on en est de cette aventure, ca me ferait plaisir tout plein.

salut

 

[Vinvinsylvain]

désoler je ne trouvais plus ma question j'avais trouver sur un autre site une réponse me disant de faire des mises en forme contisionnel
merci de ton aide

 

[Hervé]

re vinvin, le forum

Ton souci vient surement du fait que tu as inclus ta macro dans une boucle for each ws in worksheet.

Ce qui oblige à la macro d'appliquer ton code à toutes les feuilles, il faut surement supprimer cette boucle.

Ce qui devrait être fait dans le code suivant :

Dim countTot As Long
Dim counter As Long
Dim strSearchString As String
Dim Ws As Worksheet 'modif ici**************
Dim foundCell As Variant
Dim loopAddr As Variant
Dim returnValue As String
Dim strSearchString1 As String
Dim MyCollection As String

strSearchString = TxtNomVol.Value
strSearchString1 = TxtPrénomVol.Value

If strSearchString1 = '' Then strSearchString = '' Else


For Each Ws In Worksheets
countTot = countTot + Application.CountIf(Ws.UsedRange, '=' & strSearchString)
Next Ws
If countTot = 0 Then
returnValue = MsgBox(' Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' n'est pas connue de nos fichiers ', vbOKOnly, ' Message ')
Else
counter = 0
'For Each Ws In Worksheets'modif ici ********************
Set Ws = Sheets('RéCap')
With Ws
.Activate
Set foundCell = .Cells.Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
loopAddr = foundCell.Address
Do
counter = counter + 1
foundCell.Activate
If countTot = 2 Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' EST CONNUE DE NOS SERVICE, veuillez continué le constat de vol et intérroger le Récap. Interpelle ', vbOKOnly, ' Message ')
Exit Sub
End If
If counter = countTot Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' sélectionnée est la dernière !', vbOKOnly, 'Message')
Exit Sub
Else
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' a été ' & countTot & vbLf)
If returnValue = vbNo Then Exit For
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr
End If
End With
'Next Ws modif Ici**************
End If


PAr contre, je n'ai pas testé, si tu pouvais, en cas de nouveau souci, joindre un fichier exemple ca serait plus facile.

salut

 

[Vinvinsylvain]

désoler ceci ne fonctionne pas, je ne peut pas envoyer mon classeur car il fait plus de 50 ko

 

[Hervé]

re

Même en elevant les données et les macros inutiles ???

salut

 

[Mathieu]

ThisWorkbook.Worksheets('Nom_de_la_Feuille')

J'ai pas eu la patience de tout lire, mais tu n'as pas 'activé' cette macro pour une seule feuille. Avec la fonction ci-dessus ta macro sera seulement active dans la feuille où tu voudras.

Profites de regarder l'aide d'excel sur cette fonction

 

[Vinvinsylvain]

Non je ne parvient pas, j'ai rectifier encore le code mais il ne recherche que par le Nom je ne comprend plus rien!!!
voici le code:
Dim countTot As Long
Dim counter As Long
Dim strSearchString As String
Dim Ws As Object
Dim foundCell As Variant
Dim loopAddr As Variant
Dim returnValue As String
Dim strSearchString1 As String
Dim Ref As String

strSearchString = TxtNomVol.Value
strSearchString1 = TxtPrénomVol.Value

If strSearchString = '' Then strSearchString = '' Else
Ref = strSearchString '& strSearchString1

For Each Ws In Worksheets
countTot = countTot + Application.CountIf(Ws.UsedRange, '=' & Ref)
Next Ws
If countTot = 0 Then
returnValue = MsgBox(' Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' n'est pas connue de nos fichiers ', vbOKOnly, ' Message ')
Else
counter = 0
For Each Ws In Worksheets

With Ws
.Activate
Set foundCell = .Cells.Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
loopAddr = foundCell.Address
Do
counter = counter + 1
foundCell.Activate
If countTot = 1 Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' EST CONNUE DE NOS SERVICE, veuillez continué le constat de vol et intérroger le Récap. Interpelle ', vbOKOnly, ' Message ')
Exit Sub
End If
If counter = countTot Then
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' sélectionnée est la dernière !', vbOKOnly, 'Message')
Exit Sub
Else
returnValue = MsgBox('Cette Personne : ' & strSearchString & ' ' & strSearchString1 & ' a été ' & countTot & vbLf)
If returnValue = vbNo Then Exit For
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr
End If
End With
Next Ws
End If

 

[Mathieu]

J'aimerai bien t'aider mais je ne vois pas le classeur et pour les tests c'est pas evident :-/

Tu peux poster gratuitement sur rapidshare.de ton fichier

 

[Vinvinsylvain]

donne ton email je te l'envois par courrier

 

[Mathieu]

Mon e-mail est : 7cyp9k0bqr7y1xk@jetable.com (evitons le spam, utilisons jetable.com :d)

 

[Vinvinsylvain]

ok s'est envoyer ouvre le dossier, clique sur constat, un formulaire s'ouvre remplie le nom et le prénom puis clique sur editer constat, tu arrive alors sur la liste inventaire clique sur fermer et là un message dis si cette personne est connue ou pas mais mon probleme s'est qu'il recherche dans tous le classeur, moi je veut uniquement dans la feuille 'Récap. Interpelle', le fameu code se trouve dans le VBA UserFormConstat puis dans le bouton Editer

 

[Mathieu]

Voila c'est réparé

Je t'envois tout ça par mail

 

[Vinvinsylvain]

ok j'attend et je te remerci beaucoup tu va peut être me sauver car s'est un dossier que je dois montrer a une grande direction demain
merci encore, je te tient au courrant.

 

[Mathieu]

Euh je me sens très très confus, j'ai enregistré et fermé le fichier excel... et à ma grande surprise il ne fonctionne plus :-/

Je me bas pour essayer de le faire remarcher, je te tiens au courant.