Liste en cascade 4 niveaux code VBA bug fichier

Bonjour a tous!

Je suis toute nouvelle sur ce forum bien que j'utilise tres souvent excel-pratique pour trouver des reponses a mes questions. Seulement la, cela fait deja plusieurs mois (oui mois!) que je bloque. Je ne suis pourtant pas une debutante en excel, mais je ne maitrise pas parfaitement le VBA.

(mes excuses pour le texte, je n'ai pas d'accents sur mon clavier)

Alors voila le probleme:

J'avais besoin, a partir d'un tableau de 4 colonne, de creer quatre listes en cascade, et dynamiques (si on ajoute une ligne dans le tableau, il n'y a aucune autre manipulation a faire pour que les nouvelles infos s'ajoutent aux listes deroulantes.

Tout d'abord, le code fonctionne! tres contente et pas peu fiere, j'utilise maintenant le fichier quotidiennement.

Le (gros) probleme, c'est que de maniere tres aleatoire mais aussi tres frequente, le fichier beug: J'ouvre le fichier, fait mon travail, je remplis les cases, je sauve et je ferme. Puis lorsque je re-ouvre le fichier, excel me donne une erreur:

"We found a problem with some content in "your_File.xlsm". Do you want us to try to recover as much as we can?"

Je dis oui, bien sur, et je retrouve la page sur laquelle je venais de travailler sans mise en page, toute les validation de donnees ont disparues, et dans le developer, un nouveau worksheet a ete cree et ne contient plus mon code. Actuellement je n'ai pas de solution alors je recree mes validatiosn, recopie le code, refait le layout a chaque fois...

(sur le fichier joint, lorsque vous aller dans la page VBA vous aller voir de nombreux sheets, c'est en gros le nombre de fois ou le fichier a beuger, et il a recreeer un nouveau sheet sans le code...)

J'ai essayer pas mal de choses, et je suis persuader que le probleme vient de mon code, il a l'air de "corrompre" mes sheets...

Avez-vous une idee de ce qui cloche avec mon code? de la source du probleme?

Pour des raisons de confidentialite je ne peux vous envoyer mon fichier d'origine (qui presente tres frequemment le beug). Mais le code que j'utilise est ci-dessous, et je joints un fichier simplifier sans donnees (beugera, beugera pas, comme je vous le disais c'est aleatoire).

Merci de votre aide!!

Sub Worksheet_SelectionChange(ByVal Target As Range)

'Sub for dynamic dependent lists for Equipment detail in stoppages list
' Name to create from the list of Equipment:
        ' Choice_Area =OFFSET(Table_Equipment[[#Headers],[Area]],1,,COUNTA(List_EquipArea))
        ' Choice_Name =OFFSET(Table_Equipment[[#Headers],[Equipment]],1,,COUNTA(List_EquipName))
        ' Choice_No =OFFSET(Table_Equipment[[#Headers],[Equipment No.]],1,,COUNTA(List_EquipNo))
        ' Choice_Piece =OFFSET(Table_Equipment[[#Headers],[Issues]],1,,COUNTA(List_EquipPiece))

'Level 1: Choose Area
Application.EnableEvents = False

If Not Intersect(Worksheets("2").Range("k12:k31"), Target) Is Nothing And Target.Count = 1 Then           ' Target in the range of No., only one cell selected and empty
    Target.Validation.Delete                                                        ' Delete potential list in memory
    Set d1 = CreateObject("Scripting.Dictionary")
      For Each c In [Choice_Area]:  d1(c.Value) = "": Next c
      For Each c In d1.keys: temp = temp & c & ",": Next c
      Target.Validation.Delete
      Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If

'Level 2: Choose Name

If Not Intersect(Worksheets("2").Range("l12:l31"), Target) Is Nothing And Target.Count = 1 Then            ' Target in the range of Name, only one cell selected and empty
    Target.Validation.Delete                                                        ' Delete the potential list in memory
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [Choice_Name]
         If c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
       Next c
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & c & ",": Next c
         Target.Validation.Delete
         Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
       End If
End If

'Level 3: Choose No

If Not Intersect(Worksheets("2").Range("m12:m31"), Target) Is Nothing And Target.Count = 1 Then            ' Target in the range of No., only one cell selected and empty
    Target.Validation.Delete                                                        ' Delete potential list in memory
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [Choice_No]
         If c.Offset(0, -2) = Target.Offset(0, -2) And _
            c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
       Next c
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & c & ",": Next c
           Target.Validation.Delete
           Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
        End If
End If

'Level 4: Choose Component

If Not Intersect(Worksheets("2").Range("n12:n31"), Target) Is Nothing And Target.Count = 1 Then            ' If Target is in range of Component, one cell selected and empty
    Target.Validation.Delete                                                        ' Delete potential list in memory
       Set d1 = CreateObject("Scripting.Dictionary")
       For Each c In [Choice_Piece]
         If c.Offset(0, -3) = Target.Offset(0, -3) And _
            c.Offset(0, -2) = Target.Offset(0, -2) And _
            c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
       Next c
       If d1.Count > 0 Then
         For Each c In d1.keys: temp = temp & Replace(c, ",", ".") & ",": Next c
           Target.Validation.Delete
           Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
        End If
End If

Application.EnableEvents = True
End Sub
29list-cascade-vba.zip (869.24 Ko)
Rechercher des sujets similaires à "liste cascade niveaux code vba bug fichier"