Erreur Automation - L'objet invoqué s'est déconnecté de ses clients

Bonjour à tous,

J'ai un problème avec une macro qui me donne une erreur un peu compliquée, car le fichier Excel se ferme derrière et je ne peux pas chercher d’où cela vient.

J'ai un UserForm avec 1 TextBox et 2 ComboBox. Si les TextBox ne sont pas définis il me permet de les définir via les menus déroulants. Si les deux sont définis il va me demander si je veux remplacer les données.

Pour faire un check des données définies, je suis passé au début par TextBox_Change, la plus simple a utiliser. Il vérifie si les ComboBox sont définis. Si les deux le sont il va me demander si je veux écraser les données et c'est là qu'est le soucis.

Ça fonctionnait bien de 1 à 9 mais arrivé à 10, dès que je tape le 1 et que ce dernier à les deux ComboBox définis il m'affiche la demande pour écraser les données avant que je puisse taper le 0, ce qui est logique

Du coup, je me suis dit qu'il fallait passer par Before ou After, vu que je galère avec le Before je suis resté sur le After. Et c'est la qu'arrive le bug. Si je rentre le devis 1 qui est complètement défini il me demande si je veux écraser ou pas, si je dis oui pas de soucis tout se passe bien mais si je dis non, il bug complètement.

Je pense qu'il y a donc un soucis dans cette partie du code mais franchement j'ai testé plein de chose sans succès.

Je vous ai mis en pièce jointe le fichier en question.

Merci pour votre aide.

        If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then

            MsgBox "Le devis " & NuméroDevis & " n'a pas de données manquantes.", vbInformation, "Information"
            Réponse = MsgBox("Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question")

            If Réponse = vbYes Then

                ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
                AncienneCatégorie = Liste_DT.Cells(Ligne, "B")

                For i = 0 To NombreDeviseur

                    If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then

                        ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                        MailDeviseur = TableEquipeDeviseur(i, 2)

                    End If

                Next i

                Exit Sub

            Else

                NuméroDevis = ""
                Quitter = 1
                Unload Me
                Gestion.Activate

Bonjour Heelflip,

Pour commencer, j'arrêterais avec c'est IF...Then...Else imbriqué on finit par ne plus arriver à lire le code

Exemple

    If Recherche Is Nothing Then
        MsgBox "Le devis " & NuméroDevis & " n'existe pas.", vbExclamation, "Erreur - 0"
        NuméroDevis = ""
    Else

On peut très bien remplacer ce Else par

    If Recherche Is Nothing Then
        MsgBox "Le devis " & NuméroDevis & " n'existe pas.", vbExclamation, "Erreur - 0"
        NuméroDevis = ""
        Exit Sub
    End If

Autre exemple

        MsgBox "Le devis " & NuméroDevis & " n'a pas de données manquantes.", vbInformation, "Information"
        Réponse = MsgBox("Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question")
        If Réponse = vbYes Then
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            For i = 0 To NombreDeviseur

                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then

                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    MailDeviseur = TableEquipeDeviseur(i, 2)

                End If

            Next i

            Exit Sub

        Else

            NuméroDevis = ""
            Quitter = 1
            Unload Me
            Gestion.Activate

        End If

Par

    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes !" & vbCr _
          & "Voulez-vous remplacer des données existantes ?", _
            vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbYes Then
          ' Si réponse Oui
          ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
          AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
          For i = 0 To NombreDeviseur
            If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                MailDeviseur = TableEquipeDeviseur(i, 2)
            End If
          Next i
          Exit Sub
        End If
        NuméroDevis = ""
        Quitter = 1
        Unload Me
        Gestion.Activate
        ComboBoxCatégorie = "Actuellement : Non définie"
        ComboBoxDeviseur = "Actuellement : Non défini"

De plus, il faudrait cesser de mettre autant de lignes blanches dans ton code, cela prend du poids

A+

Salut Bruno,

Les lignes blanches, c'était pour le rendre plus lisible suite à une de tes remarques dans un autre post, mais c'est pas encore ça. Je ne savais pas pour les lignes blanches, je vais revoir ça.

Après ton code est pas mal j'avoue, mais j'ai encore du mal a compiler plusieurs choses en une fois comme tu le fais, par exemple mettre l'alerte et la question dans le même MsgBox, moi je pense encore étape par étape, surtout pour éviter de me perdre quand j'ai un soucis.

Enfin pour les If c'est encore compliqué, j'ai toujours eu du mal avec les logiques (J'étais nul en automatisme) je pense que ça vient avec le temps. ca doit faire un mois que je m'y suis mis et les vérification d’erreur c'est vraiment la partie la plus complique je trouve.

Et sinon pour cette erreur, tu ne sais pas d'ou cela peut venir ?

Re,

En le modifiant ainsi, je n'ai à priori pas d'erreur

Private Sub NuméroDevis_AfterUpdate()
    'Déclaration des variables
    Dim Réponse As String

    'Déclaration des objets
    Set Colonne = Liste_DT.Columns("A")
    Set Recherche = Colonne.Find(What:=NuméroDevis)

    Label2.Visible = True
    Label2.Top = 42
    Label3.Visible = True
    Label3.Top = 66
    ComboBoxCatégorie.Visible = True
    ComboBoxCatégorie.Top = 36
    ComboBoxCatégorie = ""
    ComboBoxDeviseur.Top = 60
    ComboBoxDeviseur.Visible = True
    ComboBoxDeviseur = ""
    btnValider.Top = 90
    btnQuitter.Top = 90
    U2_Compléter_Devis_Existant.Height = 165

    If NuméroDevis = "" Then Exit Sub
    If Recherche Is Nothing Then
        MsgBox "Le devis " & NuméroDevis & " n'existe pas.", vbExclamation, "Erreur - 0"
        NuméroDevis = ""
        Exit Sub
    End If
    Ligne = Recherche.Row
    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes !" & vbCr _
         & "Voulez-vous remplacer des données existantes ?", _
           vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbYes Then
            ' Si réponse Oui
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            For i = 0 To NombreDeviseur
                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    MailDeviseur = TableEquipeDeviseur(i, 2)
                End If
            Next i
            Exit Sub
        End If
        NuméroDevis = ""
        Quitter = 1
        Unload Me
        Gestion.Activate
        ComboBoxCatégorie = "Actuellement : Non définie"
        ComboBoxDeviseur = "Actuellement : Non défini"
    End If
    If Liste_DT.Cells(Ligne, "B") = "Non définie" Then

        ComboBoxCatégorie = "Actuellement : Non définie"
        Label3.Visible = False
        ComboBoxDeviseur.Visible = False
        btnValider.Top = 66
        btnQuitter.Top = 66
        U2_Compléter_Devis_Existant.Height = 140.25

    ElseIf Liste_DT.Cells(Ligne, "I") = "Non défini" Then
        ComboBoxDeviseur = "Actuellement : Non défini"
        Label2.Visible = False
        ComboBoxCatégorie.Visible = False
        Label3.Top = 42
        ComboBoxDeviseur.Top = 36
        btnValider.Top = 66
        btnQuitter.Top = 66
        U2_Compléter_Devis_Existant.Height = 140.25
    End If
    'Réinitialisation des objets
    Set Colonne = Nothing
    Set Recherche = Nothing
End Sub

A+

En effet cela fonctionne. Un grand merci.

J'essaie de me perfectionner et d'arriver à bout de la fonction BeforeUpdate qui est quand même plus pratique que l'after puisque le focus reste dans la case de départ. Le Cancel me prends la tête car j'ai du mal a comprendre ou le poser. Ici là question se pose deux fois en fin de programme.

Private Sub NuméroDevis_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    'Déclaration des objets
    Set Colonne = Liste_DT.Columns("A")
    Set Recherche = Colonne.Find(What:=NuméroDevis)

    Ligne = Recherche.Row
    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes." & vbCr & "Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbYes Then
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            For i = 0 To NombreDeviseur
                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    MailDeviseur = TableEquipeDeviseur(i, 2)
                End If
            Next i
            Exit Sub
        End If
        NuméroDevis = ""
        Quitter = 1
        Unload Me
        Gestion.Activate
    End If
    Cancel = True

End Sub

End Sub

Re,

Il faut faire Cancel si ce que tu attends n'est pas bon, donc un truc du style

Private Sub NuméroDevis_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    'Déclaration des objets
    Set Colonne = Liste_DT.Columns("A")
    Set Recherche = Colonne.Find(What:=NuméroDevis)
    Ligne = Recherche.Row
    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes." & vbCr & "Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbYes Then
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            For i = 0 To NombreDeviseur
                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    MailDeviseur = TableEquipeDeviseur(i, 2)
                End If
            Next i
            Exit Sub
        End If
        NuméroDevis = ""
        Quitter = 1
        Unload Me
        Gestion.Activate
    else
        Cancel = true
    End If
End Sub

A+

Bon bah en fait ta solution ne fonctionne pas chez moi j'ai toujours cette foutu Erreur Automation, fausse joie. Et j'ai exactement la même erreur avec le Before_Update

J'essaie de coder plein de façons différentes mais pour l'instant rien ne fonctionne.

J'ai l'impression que le soucis vient de cette partie:

NuméroDevis = ""
Quitter = 1
Unload Me
Gestion.Activate

Car après avoir cliqué sur annuler après la question il me réponse la question mais la variable NuméroDevis est absente dans le Msgbox.

N'existe pas une solution BeforeUpdate sans le Cancel ?

Private Sub NuméroDevis_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    If NuméroDevis = "" Then GoTo Fin:

    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes." & vbCr & "Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbYes Then
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            For i = 0 To NombreDeviseur
                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    MailDeviseur = TableEquipeDeviseur(i, 2)
                End If
            Next i
            Exit Sub
        End If
    End If
    Cancel = True
Fin:
    NuméroDevis = ""
    Unload Me
    Quitter = 1
    Gestion.Activate

End Sub

Cette fois ça y est c'est fonctionnel, quelle galère, voici le code final au cas ou d'autre personnes auraient besoin. J'ai scindé en deux une fonction Change et une fonction BeforeUpdate

Private Sub NuméroDevis_Change()

    'Recherche de la LigneDevisExistant devis
    Set Colonne = Liste_DT.Columns("A")
    Set Recherche = Colonne.Find(What:=NuméroDevis)

    Label2.Visible = True
    Label2.Top = 42
    Label3.Visible = True
    Label3.Top = 66
    ComboBoxCatégorie.Visible = True
    ComboBoxCatégorie.Top = 36
    ComboBoxCatégorie = ""
    ComboBoxDeviseur.Top = 60
    ComboBoxDeviseur.Visible = True
    ComboBoxDeviseur = ""
    btnValider.Top = 90
    btnQuitter.Top = 90
    U2_Compléter_Devis_Existant.Height = 165

    If NuméroDevis = "0" Then
        NuméroDevis = ""
        Exit Sub
    End If

    If Recherche Is Nothing Then
        MsgBox "Le devis " & NuméroDevis & " n'existe pas.", vbExclamation, "Erreur - 0"
        NuméroDevis = ""
    Else
        Ligne = Recherche.Row
        If Liste_DT.Cells(Ligne, "B") = "Non définie" And Liste_DT.Cells(Ligne, "I") = "Non défini" Then
            ComboBoxCatégorie = "Actuellement : Non définie"
            ComboBoxDeviseur = "Actuellement : Non défini"
            CodeRéponseMail = 1
            Exit Sub
        Else
            If Liste_DT.Cells(Ligne, "B") = "Non définie" Then
                ComboBoxCatégorie = "Actuellement : Non définie"
                Label3.Visible = False
                ComboBoxDeviseur.Visible = False
                btnValider.Top = 66
                btnQuitter.Top = 66
                U2_Compléter_Devis_Existant.Height = 140.25
                CodeRéponseMail = 1
            Else
                If Liste_DT.Cells(Ligne, "I") = "Non défini" Then
                    ComboBoxDeviseur = "Actuellement : Non défini"
                    Label2.Visible = False
                    ComboBoxCatégorie.Visible = False
                    Label3.Top = 42
                    ComboBoxDeviseur.Top = 36
                    btnValider.Top = 66
                    btnQuitter.Top = 66
                    U2_Compléter_Devis_Existant.Height = 140.25
                    CodeRéponseMail = 1
                End If
            End If
        End If
    End If

    Set Colonne = Nothing
    Set Recherche = Nothing

End Sub
Private Sub NuméroDevis_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    'Recherche de la LigneDevisExistant devis
    Set Colonne = Liste_DT.Columns("A")
    Set Recherche = Colonne.Find(What:=NuméroDevis)
    Ligne = Recherche.Row

    If NuméroDevis = "" Then
        Exit Sub
    End If

    If Liste_DT.Cells(Ligne, "B") <> "Non définie" And Liste_DT.Cells(Ligne, "I") <> "Non défini" Then
        If MsgBox("Le devis " & NuméroDevis & " n'a pas de données manquantes." & vbCr & "Voulez-vous remplacer des données existantes ?", vbQuestion + vbYesNo + vbDefaultButton2, "Question") = vbNo Then
            Cancel = True
            NuméroDevis = ""
            Quitter = 1
            Unload Me
            Gestion.Activate
        Else
            ComboBoxCatégorie = "Actuellement : " & Liste_DT.Cells(Ligne, "B")
            'AncienneCatégorie = Liste_DT.Cells(Ligne, "B")
            CodeRéponseMail = 0
            For i = 0 To NombreDeviseur
                If TableEquipeDeviseur(i, 3) = Liste_DT.Cells(Ligne, "I") Then
                    ComboBoxDeviseur = "Actuellement : " & TableEquipeDeviseur(i, 0)
                    'MailAncienDeviseur = TableEquipeDeviseur(i, 2)
                    'AncienDeviseur = EquipeDeviseur(i, 0) + TableEquipeDeviseur(i, 1)
                End If
            Next i
        End If
    End If

    Set Colonne = Nothing
    Set Recherche = Nothing

End Sub