Plantage Excel suite recherche OLEObject

Bonjour tout le monde,

J'ai un plantage systématique d'Excel lors d'un test d'existence d'une liste déroulante parmis les OLEObjects d'une feuille.

Je n'utilise pas de USERFORM, je travaille seulement avec des feuilles.

Dans mon traitement, je génère x listes déroulante par macro (1 par jour de l'année) puis je les alimentes avec une liste de chaines (activités) présents dans une autre feuille (feuille ACTIVITES). (jusque la c'est ok)

Je ne génère qu'une liste déroulante par jour (une activité) afin de ne pas avoir un fichier trop lourd, cependant je veux donner la possibilité à l'utilisateur d'en rajouter jusqu'à 4.

J'ai donc rajouté à la fin du chargement de chacune des listes, une ligne 'Ajout activité' qui est censé permettre de créer une liste de plus (4 max).

Mon problème est le suivant :

Lors de la sélection de l'option 'Ajout activité' sur la 1ère combo, pas de problème la 2ème est bien créée.

Mais quand je veux reproduire la manipulation sur la 2éme combo pour en créer une 3ème, EXCEL crash carrément et me demande de redémarrer l'application...

J'ai isolé que le problème se situait au niveau du code suivant :

Public Function TestExistenceCombo(ObjetFeuille, NomCombo)
    Dim Objas As OLEObject

    TestExistenceCombo = False

    'Cette synthaxe plante excel quand utilisée 2x de suite dans ChargementCombo ?!?
    For Each Objas In ObjetFeuille.OLEObjects
        If TypeOf Objas.Object Is MSForms.ComboBox Then
            If Objas.Name = NomCombo Then
                TestExistenceCombo = True
                Exit For
            End If
        End If
    Next Objas
End Function

Quelque peut-il m'orienter ? car je cherche depuis 2 jours et pas moyen de m'en sortir....

Merci d'avance

bonjour,

ce code appelé avec un onglet qui contient 2 comboboxes ne donne pas en soi de problème. le problème doit venir d'ailleurs dans ton code. probablement objetfeuille qui est mal défini lors du 2ème appel.

Le code des combos est généré dynamiquement et est donc le même dans chacune d'elles donc...

(Private Sub NomCombo_Change() généré dynamiquement avec comme seule modification le nom des combos)

Franchement je ne suis pas du genre à poster un message après 2 minutes de recherche...

J'ai encore passé 4 heures ce matin à essayer de régler ce p***** de problème sans succès

bonsoir,

as-tu pu identifier sur quelle ligne le code se plante ?

Bonjour,

Teste ceci pour voir :

Sub Test()

    MsgBox Existe(ActiveSheet, "MonCombo") '<-- le nom est sensé être adapté à l'objet !

End Sub

Public Function Existe(Fe As Worksheet, Nom As String) As Boolean

    Dim O As OLEObject

    For Each O In Fe.OLEObjects

        If O.Name = Nom Then Existe = True: Exit Function

    Next O

End Function

Tout d'abord, merci de me répondre

h2so4

Le code plante sur la ligne : For Each Objas In ObjetFeuille.OLEObjects

En amont, j'ai une procédure appelante (ChargementCombos) :

Public Function ChargementCombos(ObjetFeuille, Optional Creation = False)
    Dim Obj As OLEObject

    For Each Obj In ObjetFeuille.OLEObjects
        If TypeOf Obj.Object Is MSForms.ComboBox Then ChargementCombo ObjetFeuille, Obj, Creation
    Next Obj

End Function

Dans la procédure appelée (ChargementCombo) :

Public Function ChargementCombo(ObjetFeuille, ObjetCombo As OLEObject, Optional Creation = False)
    Dim i As Long

    ObjetCombo.Object.Clear

    ObjetCombo.Object.AddItem ""
    For i = 1 To 50
        If (ACTIVITES.Cells(i, 1) <> "") And (ACTIVITES.Cells(i, 2) <> "") Then
            ObjetCombo.Object.AddItem CStr(ACTIVITES.Cells(i, 2)) + String(100, " ") + CStr(ACTIVITES.Cells(i, 1))
        End If
    Next i

    Select Case Right(ObjetCombo.Name, 1)
        Case Is = "1"
           'Pas de suppression possible
           'Ajout possible si 4ème combo inexistante
           If TestExistenceCombo(ObjetFeuille, (Left(ObjetCombo.Name, (Len(ObjetCombo.Name) - 1)) + "4")) = False Then ObjetCombo.Object.AddItem "Ajout activité" + String(100, " ") + "@AJT@"

        Case Is = "2"
           'Suppression possible si 3ème combo inexistante
           If TestExistenceCombo(ObjetFeuille, (Left(ObjetCombo.Name, (Len(ObjetCombo.Name) - 1)) + "3")) = False Then ObjetCombo.Object.AddItem "Suppression activité" + String(100, " ") + "@SUP@"
           'Ajout possible si 4ème combo inexistante
           If TestExistenceCombo(ObjetFeuille, (Left(ObjetCombo.Name, (Len(ObjetCombo.Name) - 1)) + "4")) = False Then ObjetCombo.Object.AddItem "Ajout activité" + String(100, " ") + "@AJT@"

        Case Is = "3"
            Rem PROBLEME ICI !!! sur le teste d'existence de la combo -> plantage EXCEL
           'Suppression possible si 4ème combo inexistante
           If TestExistenceCombo(ObjetFeuille, (Left(ObjetCombo.Name, (Len(ObjetCombo.Name) - 1)) + "4")) = False Then ObjetCombo.Object.AddItem "Suppression activité" + String(100, " ") + "@SUP@"
'           'Ajout possible si 4ème combo inexistante
           If TestExistenceCombo(ObjetFeuille, (Left(ObjetCombo.Name, (Len(ObjetCombo.Name) - 1)) + "4")) = False Then ObjetCombo.Object.AddItem "Ajout activité" + String(100, " ") + "@AJT@"

        Case Is = "4"
           'Suppression
           ObjetCombo.Object.AddItem "Suppression activité" + String(100, " ") + "@SUP@"
           'Pas d'ajout possible
    End Select

    ObjetCombo.Object.ListRows = ObjetCombo.Object.ListCount
    If Creation = True Then ObjetCombo.Object.ListIndex = 0
End Function

Dans la fonction 'TestExistenceCombo', j'utilise également ce parcours (For Each Obj In ObjetFeuille.OLEObjects...) pour tester l'existence d'une combo.

C'est donc cette fonction 'TestExistenceCombo' qui plante à la 2ème utilisation (ça marche pour la 1ère !!!)

Donc, pour résumer, un parcours des OLEObjects de la feuille et un nouveau parcours dans ce parcours.

Peut être une histoire de verouillage...

Merci d'avance

Bonjour,

Pour information, j'ai contourné le problème en modifiant la procédure TestExistenceCombo afin de générer une erreur si la combo passée en paramètre n'existe pas :

Public Function TestExistenceCombo(ObjetFeuille As Worksheet, NomCombo As String)
    TestExistenceCombo = True

    On Error GoTo popol
        ObjetFeuille.OLEObjects(NomCombo).Select

popol:
        TestExistenceCombo = False

End Function

C'est pas joli joli mais ça marche....

Merci à tous