Erreur aléatoire lors de l'ajout d'une ligne dans un tableau

Le 13/09/2021 à 14:29

Bonjour, j'aurais besoin d'aide pour résoudre une erreur aléatoire (parfois le code marche et parfois l'erreur ce produit) sur un code VBA :

Erreur d'exécution '_2147417848 (800 10 108)':

La méthode '_Default' de l'objet 'Range' a échoué

Quand l'erreur survient excel a ajouté une ligne au tableau mais rempli uniquement la colonne du service et ne prolonge pas les formules du tableau ni la mise en forme conditionnelle. Et le logiciel excel plante et redémarre.

Je ne comprend pas d'ou vient le problème.

Dim Derligne As Integer
'On Error Resume Next
    Derligne = Sheets("Base de données").Range("A9999").End(xlUp).Row + 1 'Sélectionne la feuille, descend à la A9999 puis remonte jusqu'à la dernière cellule non vide et descend de 1.

   'L'ERREUR SURVIENT SUR LA LIGNE SUIVANTE.
    Cells(Derligne, 2) = Combo_Service.Value
    Cells(Derligne, 3) = Combo_Auto.Value
    Cells(Derligne, 4) = Combo_Nom.Value
    Cells(Derligne, 5) = Combo_Prénom.Value
    Cells(Derligne, 6) = Text_AP.Value
    Cells(Derligne, 7) = Text_Numhab.Value
    Cells(Derligne, 8) = CDate(Text_Date_Début.Value)
    Cells(Derligne, 13) = Combo_Status.Value
    Cells(Derligne, 14) = Text_Etat.Value
21hbmd-test.xlsm (152.09 Ko)

EDIT: Je viens de remarquer que l'erreur ce produisait suite à: utilisation du code via le formulaire de saisi, fermeture du formulaire , réouverture du formulaire réutilisation du code => erreur.

Tant que je ne ferme pas le formulaire le code à l'air de fonctionner sans erreur. Je continus de tester pour voir.

Le 13/09/2021 à 19:58

Bonsoir,

Votre erreur est ici :

Me.List_Gestionnaire.RowSource = "DECALER"

La propriété "RowSource" ne peut pas être utilisée pour une plage modifiée à l'exécution. Cela fait planter Excel. Il faut utiliser la propriété "List".

Le 13/09/2021 à 21:04

L'erreur survient dans la "Private Sub Bouton_Ajouter_Click" et non dans la" Private Sub Bouton_Rechercher_Click" qui fonctionne très bien ...

Le problème survient après fermeture combiné à la réouverture du formulaire(userform) de saisi.

Le 13/09/2021 à 22:16

L'erreur survient dans la "Private Sub Bouton_Ajouter_Click
Bien sûr, car en ajoutant un élément à la base de données que vous avez référencé avec la propriété "RowSource", vous modifiez ce à quoi fait référence votre "RowSource". Encore une fois, cela fait planter Excel !

Le 14/09/2021 à 09:14

ok merci je vais réfléchir à ça

je viens de tester en supprimant complètement la partie de code (" Private Sub Bouton_Rechercher_Click") que tu incrimines thev mais le problème persiste quand même.

Le 14/09/2021 à 10:29

le problème persiste quand même.
Sauf que cette instruction est utilisée ailleurs

Me.List_Gestionnaire.RowSource = ""

Ceci serait mieux :

Me.List_Gestionnaire.Clear

Et pour remplacer l'instruction dans " Private Sub Bouton_Rechercher_Click"

Me.List_Gestionnaire.List = [Tableau_Basededonnées].ListObject.DataBodyRange.Value

Le 14/09/2021 à 16:30

J'ai fait tous les remplacements que tu m'as indiqué mais le problème persiste.

Je pense que le bug se situe dans l'insertion automatique de la ligne du "Tableau_Basededonnées"

j'ai modifié comme ceci :

 Sheets("Base de données").ListObjects("Tableau_Basededonnées").ListRows.Add

    Dim Derligne As Integer
    Derligne = Sheets("Base de données").Range("A9999").End(xlUp).Row

et avec les mêmes conditions(fermeture du userform puis réouverture) je me retrouve cette fois avec cette erreur: La méthode 'add' de l'objet 'ListRows' a échoué.

Tant que le userform n'est pas fermé je peux ajouter des lignes sans erreurs mais dès qu'il est fermé puis réouvert excel va générer une erreur au bout de une ou deux nouvelle saisi.

Le 14/09/2021 à 17:48

Je pense que le bug se situe dans l'insertion automatique de la ligne du "Tableau_Basededonnées"
Le bug est toujours relatif à l'utilisation de la propriété "RowSource" pour votre base de données car vous l'utilisez également pour vos combobox's. Donc à supprimer et à remplacer par :

Private Sub UserForm_Initialize()

    With [Tableau_Basededonnées].ListObject
        If .ListRows.Count > 1 Then
            Me.Combo_Nom.List = .ListColumns("nom").DataBodyRange.Value
            Me.Combo_Prénom.List = .ListColumns("Prénom").DataBodyRange.Value
            Me.Combo_Auto.List = .ListColumns("Automate").DataBodyRange.Value
            Me.Combo_Service.List = .ListColumns("Service").DataBodyRange.Value
        Else
            Me.Combo_Nom.AddItem .ListColumns("nom").DataBodyRange.Value
            Me.Combo_Prénom.AddItem .ListColumns("Prénom").DataBodyRange.Value
            Me.Combo_Auto.AddItem .ListColumns("Automate").DataBodyRange.Value
            Me.Combo_Service.AddItem .ListColumns("Service").DataBodyRange.Value
        End If

    End With

End Sub

Par ailleurs, pour un tableau structuré, le code que vous utilisez est obsolète et l'emloi du nom de la feuille contenant le tableau n'est pas nécessaire. Il faut se servir de la classe "ListObject".
ci-dessous exemple de code :

Private Sub Bouton_Ajouter_Click()
    Dim i As Integer

    With [Tableau_Basededonnées].ListObject

        .Range.Worksheet.Unprotect ("")
        .Range.Worksheet.Visible = True

        If Combo_Auto.Value = "" Or Combo_Service.Value = "" Or Combo_Nom.Value = "" Or Combo_Prénom.Value = "" Or Text_Date_Début.Value = "" Or Text_AP.Value = "" Then
           MsgBox ("Merci de compléter les champs manquants.")

        Else
            If Text_ID <> "" Then
                Dim cell As Range

                Set cell = .ListColumns("ID").Range.Find(Text_ID, , xlValues, xlWhole, , , False)
                If Not cell Is Nothing Then
                    i = cell.Row - .HeaderRowRange.Row

                    .ListColumns(2).DataBodyRange(i) = Combo_Service.Value
                    .ListColumns(3).DataBodyRange(i) = Combo_Auto.Value
                    .ListColumns(4).DataBodyRange(i) = Combo_Nom.Value
                    .ListColumns(5).DataBodyRange(i) = Combo_Prénom.Value
                    .ListColumns(6).DataBodyRange(i) = Text_AP.Value
                    .ListColumns(7).DataBodyRange(i) = Text_Numhab.Value
                    .ListColumns(8).DataBodyRange(i) = CDate(Text_Date_Début.Value)
                    .ListColumns(11).DataBodyRange(i) = Text_CRP.Value
                    .ListColumns(12).DataBodyRange(i) = Combo_QCM.Value
                    .ListColumns(13).DataBodyRange(i) = Combo_Status.Value
                    .ListColumns(14).DataBodyRange(i) = Text_Etat.Value
                End If

            Else
                Text_Etat = "Actif"
                Text_Numhab = "1"
                Combo_Status = "Ouvert"

                Dim ligne As ListRow
                Set ligne = .ListRows.Add: i = ligne.Index

                .ListColumns(2).DataBodyRange(i) = Combo_Service.Value
                .ListColumns(3).DataBodyRange(i) = Combo_Auto.Value
                .ListColumns(4).DataBodyRange(i) = Combo_Nom.Value
                .ListColumns(5).DataBodyRange(i) = Combo_Prénom.Value
                .ListColumns(6).DataBodyRange(i) = Text_AP.Value
                .ListColumns(7).DataBodyRange(i) = Text_Numhab.Value
                .ListColumns(8).DataBodyRange(i) = CDate(Text_Date_Début.Value)
                .ListColumns(13).DataBodyRange(i) = Combo_Status.Value
                .ListColumns(14).DataBodyRange(i) = Text_Etat.Value

            End If

            'Vide les champs de saisie
            Text_ID = ""
            Combo_Auto = ""
            Combo_Service = ""
            Combo_Nom = ""
            Combo_Prénom = ""
            Text_AP = ""
            Text_Numhab = ""
            Text_Date_Début = ""
            Text_Date_Fin = ""
            Combo_Hab = ""
            Combo_Status = ""
            Text_CRP = ""
            Combo_QCM = ""
            Text_Etat = ""

         End If

            .Range.Worksheet.Protect ("")
    End With

    Worksheets("Gestion").Select

End Sub

NB : remplacer les indices de colonnes par leur nom serait encore mieux car cela faciliterait une maintenance ultérieure en cas d'insertion de nouvelles colonnes.

Le 14/09/2021 à 18:42

Je veux bien te croire quand tu me dis que mon code est obselète vu que je fais de la récup à droite et à gauche des codes VBA que j'adapte pour faire mes fichiers excel

sinon j'ai essayer avec ton code et je sens que tu va me détester mais il me met un erreur méthode 'add' de l'objet 'ListRows' a échoué sur cette ligne :

Set ligne = .ListRows.Add: i = ligne.Index
Le 14/09/2021 à 19:40

sinon j'ai essayer avec ton code et je sens que tu va me détester mais il me met un erreur méthode 'add' de l'objet 'ListRows' a échoué sur cette ligne :

Tu n'as pas supprimé les "RowSource" de tes Combobox's !! :
Combo_nom RowSource = List_Nom,
Combo_Prénom RowSource = List_Prénom,
Combo_Auto RowSource = List_Automate,
Combo_Service RowSource = List_Service,

capture1

Sinon, ci-jointe une version qui fonctionne

16hbmd-test1.xlsm (150.83 Ko)
Le 14/09/2021 à 20:03

En effet , ça m'a l'air de fonctionné sans problème.

Merci à toi pour ton aide précieuse .

Le 15/09/2021 à 09:28

Bonjour,

Une petite correction à apporter dans la procédure ci-dessous si le tableau structuré est vide, c'est à dire si le nombre de lignes (ListRows.Count) = 0. Car dans ce cas, l'utilisation de la propriété DataBodyRange provoque une erreur.

Private Sub UserForm_Initialize()

    With [Tableau_Basededonnées].ListObject
        If .ListRows.Count > 1 Then
            Me.Combo_Nom.List = .ListColumns("nom").DataBodyRange.Value
            Me.Combo_Prénom.List = .ListColumns("Prénom").DataBodyRange.Value
            Me.Combo_Auto.List = .ListColumns("Automate").DataBodyRange.Value
            Me.Combo_Service.List = .ListColumns("Service").DataBodyRange.Value
        ElseIf .ListRows.Count = 1 Then
            Me.Combo_Nom.AddItem .ListColumns("nom").DataBodyRange.Value
            Me.Combo_Prénom.AddItem .ListColumns("Prénom").DataBodyRange.Value
            Me.Combo_Auto.AddItem .ListColumns("Automate").DataBodyRange.Value
            Me.Combo_Service.AddItem .ListColumns("Service").DataBodyRange.Value
        End If

    End With

End Sub
Rechercher des sujets similaires à "erreur aleatoire lors ajout ligne tableau"