[VBA Excel 2003] Modifications en cascade dans tous les onglets

Taddy

XLDnaute Nouveau
Bonjour tout le monde,

Je me retourne vers vous parce que je sèche complètement depuis deux jours maintenant.

Dans mon fichier Excel, je veux effectuer des modifications en cascade. Je m'explique, si une personne modifie le nom et/ou civilité et/ou le prénom dans la feuille "Personnes", je dois modifier toutes les entrées correspondantes à cette personnes dans les autres onglets. Je ne veux pas faire une recherche par une input box, mais à partir du moment ou la personne modifie le nom ou le prénom et la civilité.

j'ai trouvé un code permettant de faire une recherche sur plusieurs feuilles et je l'ai adapté pour le remplacement. Le problème qui se pose est d'une part que j'ai une boucle infinie... cad il commence par faire les modifications puis il boucle sur les autres noms qui eux n'ont pas été "modifiés". et maintenant, j'ai un autre problème avec Application.CountIf(ws.UsedRange, "=" & chaine).

Je vous joins mon fichier pour mieux comprendre et donc pour mieux m'aider.
Il faut savoir que je concatène les champs civilité, nom, particule, prénom et que la valeur qui remplace est la concaténation (colonne masquée Z de la feuille "Personnes")

Je désespère de trouver une solution, et je remercie d'avance toutes les personnes qui s'intéresseront à mon problème.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Object
Dim foundCell As Variant
Dim chaine, returnValue, rempl As String
Dim total, cpt As Long

chaine = Cells(Target.Row, Range("Personne_Concat").Column).Value
rempl = Cells(Target.Row, "Z").Value

If Len(chaine) = 0 Then
    Exit Sub
Else
    For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
        total = total + Application.CountIf(ws.UsedRange, "=" & chaine)
    Next ws
End If
If total = 0 Then
    MsgBox "Il n'existe pas d'autre entrée correspondant à cette personne", vbOKOnly, "Message"
    Exit Sub
Else
    cpt = 0
For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
With ws
    .Activate
    Set foundCell = .Cells.Find(What:=chaine, LookIn:=xlValues, LookAt:=xlPart)
    If Not foundCell Is Nothing Then
    Do
         cpt = cpt + 1
         foundCell.Activate
         Select Case total
             Case Is = 1
                 MsgBox "Il existe une seule entrée correspondant à " & chaine, vbOKOnly, "Message"
                 foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
                 MsgBox "Cette entrée a été remplacée par : " & rempl, vbOKOnly, "Message"
                 Exit Sub
             Case Is = cpt
                 MsgBox "Dernière entrée correspondant à " & chaine, vbOKOnly, "Message"
                 foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
                 MsgBox "Fin des modifications pour : " & chaine, vbOKOnly, "Message"
                 Sheets("Personnes").Activate
                 Range("C3").Select
                 Exit Sub
             Case Else
                 MsgBox "Entrée n° " & cpt & " correspondant à " & chaine, vbOKOnly, "Message"
                 foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
                 returnValue = MsgBox("Cette entrée a été remplacée par : " & rempl & vbLf & "Voulez-vous continuer les modifications ?", vbYesNo, "Message")
                 
                 If returnValue = vbNo Then
                     Exit Sub
                 Else
                     Set foundCell = .Cells.FindNext(After:=foundCell)
                 End If
         End Select
    Loop Until foundCell Is Nothing
    Else
        Exit Sub
    End If
End With
Next ws
End If

End Sub
 

Pièces jointes

  • Fichier test.xls
    23 KB · Affichages: 80
  • Fichier test.xls
    23 KB · Affichages: 73
  • Fichier test.xls
    23 KB · Affichages: 83
Dernière édition:

skoobi

XLDnaute Barbatruc
Re : [VBA Excel 2003] Modifications en cascade dans tous les onglets

Bonjour,

comme la feuille est modifiée pendant le traitement, la macro se relance.
Pour éviter cela, ajoute ceci:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[B]Application.EnableEvents = False[/B]
………
………….
[B]Application.EnableEvents = True[/B]
End Sub
 

Taddy

XLDnaute Nouveau
Re : [VBA Excel 2003] Modifications en cascade dans tous les onglets

Bonjour Skoobi,

Merci pour ton aide, l'ajout de Application.Event en début et en fin de ma Sub, a partiellement résolu mon problème...

En fait c'est de ma faute, j'ai pas mit mon fichier dans son ensemble... Mon problème venait du fait que j'avais deux évènements dans la feuille qui se croisaient et qui permutaient entre eux à savoir SelectionChange et Change.

Du coup je ne voyais jamais la fin de ma Sub Worksheet_Change.

Mais c bon, ça marche maintenant.

Merci pour ton aide, @++
 

Discussions similaires