Microsoft 365 La méthode 'Add' de l'objet 'ListRows' a échoué

SCorbeil

XLDnaute Nouveau
Bonjour à tous,

Je travaille actuellement sur un outil de gestion des dossiers de projets. J'ai créé une Worksheet intitulée "CONFIG" qui me permet de stocker plusieurs petits tableaux qui servent entre autres pour les différentes listes déroulantes des UserForms. Chaque tableau est conformément nommé ainsi que les plages pour les listes déroulantes.

Je rencontre une problématique de code qui fait planter EXCEL lorsque je tente d'enregistrer de nouvelles données dans un tableau de la Worksheet "CONFIG". Voici le code actuellement déficient :
VB:
Private Sub CmdAjoutTypeClient_Click()  'Ne fonctionne pas vraiment...

Dim L As Long
Dim LO As ListObject, LR As ListRow

If Me.TxtIntituleTypeClient <> "" And Me.TxtAbrevTypeClient <> "" Then

    'Demander une confirmation de l'enregistrement des informations client
    If MsgBox("Voulez-vous enregistrer les nouvelles informations et quitter ce formulaire ?", vbYesNo) = vbYes Then
   
    Set LO = ThisWorkbook.Sheets("CONFIG").Range("TabTypeClient").ListObject
    With LO
        Set LR = .ListRows.Add
        L = LR.Index
       
        .ListColumns(0).DataBodyRange.Rows(L) = Me.TxtIntituleTypeClient
        .ListColumns(1).DataBodyRange.Rows(L) = Me.TxtAbrevTypeClient
       
    End With
   
    End If
   
    'Réappliquer le filtre de la table
    ThisWorkbook.Sheets("CONFIG").ListObjects("TabTypeClient").AutoFilter.ApplyFilter
   
    With Sheets("CONFIG").ListObjects("TabTypeClient"). _
            Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
    End With
   
    Set LO = Nothing
    Set LR = Nothing
   
    'Nettoyer les TextBox
    Me.TxtIntituleTypeClient = ""
    Me.TxtAbrevTypeClient = ""
   
    ActiveWorkbook.RefreshAll
    ThisWorkbook.Save

End If

End Sub

Il vous est possible de vous référer à l'environnement du UserForm via l'image JPG ci-jointe.

J'anticipe que je rencontrerai possiblement d'autres problématiques avec le CommandButton de mise à jour de l'information ainsi que celui qui permettra de supprimer une information.

Bref, je suis possiblement si près de l'arbre que j'ai de la difficulté à voir la forêt...

Merci de votre collaboration.
 

Pièces jointes

  • Formulaire de gestion des paramètres - Module GESTION.jpg
    Formulaire de gestion des paramètres - Module GESTION.jpg
    94.1 KB · Affichages: 28
  • Worksheet CONFIG - Tableau correspondant.jpg
    Worksheet CONFIG - Tableau correspondant.jpg
    35.5 KB · Affichages: 43
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, SCorbeil

Scorbeil
Il est aussi possible de référer au fichier Excel exemple que tu daignerais joindre ici ;)
(Tu as tout le temps de le concocter, non ?
Il y a une chance sur deux que tu sois confiné)
 
Dernière édition:

SCorbeil

XLDnaute Nouveau
Bonjour le fil, SCorbeil

Scorbeil
Il est aussi possible de référer au fichier Excel exemple que tu daignerais joindre ici ;)
(Tu as tout le temps de le concocter, non ?
Il y a une chance sur deux que tu sois confineé)

Bonjour Staple1600,

Le temps, nous l'avons... ;)

Voici le fichier EXEMPLE.

Espérant le tout à la hauteur de vos attentes.
 

Pièces jointes

  • Exemple V1.0.xlsm
    47 KB · Affichages: 5

Staple1600

XLDnaute Barbatruc
Re

Merci pour le fichier.
Mais celui-ci semble être coronavérolé ;)
(Il plante et ferme mon Excel illico)
Du coup, sur mon propre fichier de test, ceci fonctionne
(Un userform+ 2 TextBox + 1 CommandButton)
VB:
Private Sub CommandButton1_Click()
Dim LO As ListObject, L&
Set LO = Sheets(1).ListObjects("Tableau1")
LO.ListRows.Add AlwaysInsert:=True
L = LO.DataBodyRange.Rows.Count
LO.DataBodyRange(L, 1) = TextBox1
LO.DataBodyRange(L, 2) = TextBox2
End Sub
A toi de voir ce que cela t'inspire sur ton propre fichier ;).
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Il y a un pb sur le tableau TabTypeClient
J'ai essayé sur un tableau2 et il n'y a pas de pb

VB:
Private Sub B_ajout_Click()
  enreg = [Tableau2].Rows.Count + 1
  [Tableau2].Item(enreg, 1) = Me.TextBox1
  [Tableau2].Item(enreg, 2) = Me.TextBox2
End Sub


Boisgontier
 

patricktoulon

XLDnaute Barbatruc
re
bonjour
depuis QUAND un index colonne ou row dans un sheet ou tableau structuré ou tcd est en base 0 !!!!!!!!
.ListColumns(0).DataBodyRange.Rows(L) = "toto"
.ListColumns(1).DataBodyRange.Rows(L) = "truc"

c'est 1 et 2 et non pas 0 et 1
tout indexation sur feuille est en base 1
;)
demo3.gif
 

Staple1600

XLDnaute Barbatruc
Re, Bonjour JB

Ah, donc je ne rêvais pas.
Et puisque j'ai lu ton message, alors j'adapte mon précédent code en conséquence.
VB:
Private Sub CommandButton1_Click()
Dim LO As ListObject, L&
Set LO = Sheets(1).ListObjects("Tableau1")
L = LO.DataBodyRange.Rows.Count
LO.DataBodyRange(L + 1, 1) = TextBox1
LO.DataBodyRange(L + 1, 2) = TextBox2
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Et juste pour le fun, et varier la syntaxe ;)
VB:
Private Sub CommandButton1_Click()
Dim LO As ListObject: Set LO = Sheets(1).ListObjects("Tableau1")
LO.DataBodyRange(LO.DataBodyRange.Rows.Count + 1, 1).Resize(, 2) = Array(TextBox1, TextBox2)
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Donc en faisant de l'émulation synergétique
(dans ce cas et dans ma configuration "exemplaire")
Autant faire ceci pour moins pédaler, non ? ;)
VB:
Private Sub CommandButton1_Click()
Sheets(1).ListObjects("Tableau1").ListRows.Add.Range = Array(TextBox1, TextBox2, Empty)
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
je l'ai vu
je pense que quand on travaille en listobject on reste en listobject
on resize pas le range du TS pour ajouter une listrow même si ça marche

ça permet au développeur ou celui qui reprend le petit de s'y retrouver ;)
c'est mon point de vue ;)
l'utilisation de range doit etre juste pour l'ecriture
VB:
With ThisWorkbook.Sheets("CONFIG").Range("TabTypeClient").ListObject.ListRows.Add
    .Range.Value = Array(Me.TxtIntituleTypeClient, Me.TxtAbrevTypeClient)
End With
ben on c'est croisé on a eu la meme idée ;)
 

SCorbeil

XLDnaute Nouveau
Re

Merci pour le fichier.
Mais celui-ci semble être coronavérolé ;)
(Il plante et ferme mon Excel illico)
Du coup, sur mon propre fichier de test, ceci fonctionne
(Un userform+ 2 TextBox + 1 CommandButton)
VB:
Private Sub CommandButton1_Click()
Dim LO As ListObject, L&
Set LO = Sheets(1).ListObjects("Tableau1")
LO.ListRows.Add AlwaysInsert:=True
L = LO.DataBodyRange.Rows.Count
LO.DataBodyRange(L, 1) = TextBox1
LO.DataBodyRange(L, 2) = TextBox2
End Sub
A toi de voir ce que cela t'inspire sur ton propre fichier ;).

OH! Je vais procéder à un petit scan de mon fichier de base de données...
Je te remercie pour l'info sur la CODE-VID-19 :rolleyes: qui fait planter systématiquement EXCEL.

C'est avec plaisir que je testerai ton code mon brave.

Grand merci à toi
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 920
Membres
101 840
dernier inscrit
SamynoT