Problème de compatibilité

[Marie30]

Bonjour à tous,

J'ai développé une macro sous excel 2007 permettant de remplir une combobox 1 en fonction d'une liste de famille et la combobox2 en fonction de la catégorie correspodant à la famille.

Voilà ma macro :

Private Sub UserForm_Initialize() 'Avant le chargement de l'Usf
Set listeFam = CreateObject("Scripting.Dictionary")
With Sheets("fam") 'créer une liste sans doublons des Familles
    
    For Each c In .Range("D2:D" & .Range("D65000").End(xlUp).Row)
        
        If Not listeFam.exists(c.Value) Then
            listeFam(c.Value) = c.Value
        End If
    Next c

End With
ComboBox1.List = listeFam.keys

Private Sub ComboBox1_Change() 'lors de la sélection d'une famille
If ComboBox1.ListIndex = -1 Then
    MsgBox "Vous devez sélectionner une famille"
    Exit Sub
Else
    Set ListeCat = CreateObject("scripting.Dictionary")
    With Sheets("fam") 'créer une liste sans doublons des Familles
        For Each c In .Range("e2:D" & .Range("e65000").End(xlUp).Row)
            If c.Offset(0, -1).Value = ComboBox1.Text Then
                If Not ListeCat.exists(c.Value) Then ListeCat(c.Value) = c.Value
            End If
        Next c
    End With
    ComboBox2.List = ListeCat.keys 'afficher la liste des Catégories, sans doublons
End If
End Sub

Elle fonctionne parfaitement sur mon PC , par contre sur d'autre PC disposant d'excel2003 ou autre elle ne fonctionne pas. Excel bug au niveau de la scripting dictionnary ....

J'ai donc modifié la première partie du code permettant de remplir la combobox1

Private Sub UserForm_Initialize() 'Avant le chargement de l'Usf
Dim i As Integer
Dim compt As Integer
Dim tat As Integer
Dim b As Integer


With Sheets("fam") 'créer une liste sans doublons des Familles
    
    For i = 2 To .Range("E65000").End(xlUp).Row
        
        ComboBox1.AddItem .Cells(i, 4)
    Next

End With

compt = ComboBox1.ListCount - 1

i = 0

Do Until i = compt
    If ComboBox1.List(i) = ComboBox1.List(i + 1) And ComboBox1.List(i) <> "" Then
        ComboBox1.RemoveItem (i)
        compt = compt - 1
        i = i - 1
    End If
    i = i + 1
Loop

Hélas je n'arrive pas à modifier la partie pour remplir le combobox2 sans utiliser scripting dictionnary. Cad ce bout de code :

Private Sub ComboBox1_Change() 'lors de la sélection d'une famille
If ComboBox1.ListIndex = -1 Then
    MsgBox "Vous devez sélectionner une famille"
    Exit Sub
Else
    Set ListeCat = CreateObject("scripting.Dictionary")
    With Sheets("fam") 'créer une liste sans doublons des Familles
        For Each c In .Range("e2:D" & .Range("e65000").End(xlUp).Row)
            If c.Offset(0, -1).Value = ComboBox1.Text Then
                If Not ListeCat.exists(c.Value) Then ListeCat(c.Value) = c.Value
            End If
        Next c
    End With
    ComboBox2.List = ListeCat.keys 'afficher la liste des Catégories, sans doublons
End If
End Sub

Pouvez vous m'aider svp ?
Je suis disponible si vous avez des questions .

Merci à tous !

Marie

 

[13GIBE59]

Re : Problème de compatibilité

Bonjour Marie.
Essaie avec les NoDupes :

Sheets("fam").Select
    Range([E2], [E65536].End(xlUp)).Select
    On Error Resume Next
    A = Selection.Value
    For n = 1 To UBound(A, 1)
        NoDupes.Add A(n, 1), CStr(A(n, 1))
    Next n
    On Error GoTo 0
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
    For X = 1 To NoDupes.Count
        Me.ComboBoxMode.AddItem NoDupes(X)
    Next X

 

[Marie30]

Re : Problème de compatibilité

Merci Jean-Bernard mais je viens de trouver une solution fonctionnelle

Private Sub ComboBox1_Change() 'lors de la sélection d'une famille

Dim famille As String

If ComboBox1.ListIndex = -1 Then
    MsgBox "Vous devez sélectionner une famille"
    Exit Sub
Else
    
    famille = ComboBox1.Value

    With Sheets("fam") 'créer une liste sans doublons des Familles
        
        For i = 2 To .Range("E65000").End(xlUp).Row
            
            If .Cells(i, 4).Value = famille Then
                ComboBox2.AddItem .Cells(i, 5)
            End If
        Next
    
    End With
    
    compt = ComboBox2.ListCount - 1
    
    i = 0
    
    Do Until i = compt
        If ComboBox2.List(i) = ComboBox2.List(i + 1) And ComboBox2.List(i) <> "" Then
            ComboBox2.RemoveItem (i)
            compt = compt - 1
            i = i - 1
        End If
        i = i + 1
    Loop

End If
End Sub

Bon weekend à tous