Problème code + message erreur

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

J'ai mis en place ce code qui me permet de remplir un tableau dans une feuille de calcul à partir d'un Uf. Je n'ai rencontré aucun problème lors du remplissage de la 1ère ligne du tableau.
Lorsque que j'ai voulu en saisir une 2ème, 2 messages sont apparus au moment de la validation à partir de l'UF :

J'ai déjà utilisé ce code par ailleurs et il fonctionne bien, dans cette application il bug, je ne comprends pas !!

1 - "La méthode ADD a échoué"

2 - Erreur système & H80010108 (-2147417848). L'objet invoqué s'est déconnecté de ses clients.

Voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
 
Private Sub bouton1_Click()
Dim DL As Integer
 
    If Me.Txt_Descrip <> "" And Me.Txt_Design <> "" And Me.Txt_PAHT <> "" And Me.Txt_Stock <> "" And Me.Cmb_Fourn.ListIndex <> "" And Me.Cmb_Tva.ListIndex <> "" Then
 
        Sheets("Articles").ListObjects(1).ListRows.Add
               DL = Sheets("Articles").Range("B1048546").End(xlUp).Row
 
        'On ajoute les articles au tableau de la feuille "Articles"
        With Sheets("Articles")
        .Range("B" & DL) = Me.Label_NumEnr.Caption
        .Range("C" & DL) = Me.Cmb_Fourn
        .Range("E" & DL) = Me.Txt_Design
        .Range("F" & DL) = Me.Txt_Descrip
        .Range("G" & DL) = CDbl(Me.Txt_PAHT)
        .Range("H" & DL) = Me.Cmb_Tva
        .Range("I" & DL) = CInt(Me.Txt_Nobre)
        .Range("L" & DL) = CInt(Me.Txt_Stock)
        .Range("N" & DL) = "Active"
 
        'On ajoute +1 à la cellule C4 de la feuille "Données" - ART-00001 + 1 = ART-00002
        Sheets("Données").Range("C4") = Sheets("Données").Range("C4") + 1
        End With
 
        'On efface ce qu'il ya dans les contrôles de l'UF
        Me.Cmb_Fourn = ""
        Me.Txt_Design = ""
        Me.Txt_Descrip = ""
        Me.Txt_PAHT = ""
        Me.Cmb_Tva = ""
        Me.Txt_Nobre = ""
        Me.Txt_Stock = ""
        ThisWorkbook.Save
     End If
End Sub

Merci par avance pour votre aide.

Citation:

Envoyé par Vba14

Bonjour,

Il serait plus simple de travailler avec un objet ListRow. Le code ci-dessous est à adapter pour que les colonnes soient remplies avec les bons champs. J'ai neutralisé vos lignes de codes simplement pour illustrer l'exemple. Je suppose par ailleurs que le tableau commence en colonne A.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
Private Sub bouton1_Click()
'Dim DL As Integer
Dim MonArticle As ListRow
 
   ' If Me.Txt_Descrip <> "" And Me.Txt_Design <> "" And Me.Txt_PAHT <> "" And Me.Txt_Stock <> "" And Me.Cmb_Fourn.ListIndex <> "" And Me.Cmb_Tva.ListIndex <> "" Then
 
        Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add
           '    DL = Sheets("Articles").Range("B1048546").End(xlUp).Row
 
        'On ajoute les articles au tableau de la feuille "Articles"
 
        With MonArticle
 
            .Range(1, 2) = "B"
            .Range(1, 3) = "C"
            .Range(1, 5) = "E"
            .Range(1, 6) = "F"
            .Range(1, 7) = "G"
            .Range(1, 8) = "H"
            .Range(1, 9) = "I"
            .Range(1, 12) = "L"
            .Range(1, 14) = "N"
 
        End With
 
        Set MonArticle = Nothing
 
 
     '   With Sheets("Articles")
     '   .Range("B" & DL) = Me.Label_NumEnr.Caption
     '   .Range("C" & DL) = Me.Cmb_Fourn
     '   .Range("E" & DL) = Me.Txt_Design
     '   .Range("F" & DL) = Me.Txt_Descrip
     '   .Range("G" & DL) = CDbl(Me.Txt_PAHT)
     '   .Range("H" & DL) = Me.Cmb_Tva
     '   .Range("I" & DL) = CInt(Me.Txt_Nobre)
     '   .Range("L" & DL) = CInt(Me.Txt_Stock)
     '   .Range("N" & DL) = "Active"
 
        'On ajoute +1 à la cellule C4 de la feuille "Données" - ART-00001 + 1 = ART-00002
     '   Sheets("Données").Range("C4") = Sheets("Données").Range("C4") + 1
     '   End With
 
        'On efface ce qu'il ya dans les contrôles de l'UF
      '  Me.Cmb_Fourn = ""
      '  Me.Txt_Design = ""
      '  Me.Txt_Descrip = ""
      '  Me.Txt_PAHT = ""
      '  Me.Cmb_Tva = ""
      '  Me.Txt_Nobre = ""
      '  Me.Txt_Stock = ""
      '  ThisWorkbook.Save
    ' End If
End Sub

12/04/2019, 17h23
Vba14

Bonjour Eric,

Merci pour votre participation. Mon tableau commence en colonne B.

Je vais regarder votre code et le tester en directe dans mon appli et je reviens vous dire ce qu'il en est.
12/04/2019, 17h27
Invité

Citation:

Envoyé par Vba14

Mon tableau commence en colonne B.

Dans ce cas, il faut simplement modifier les numéros de colonne dans les lignes .Range(1,...) = "XXXX"
12/04/2019, 17h41
Vba14
J'ai fait un premier test, et dans mes colonnes du tableau arrivent les lettres du code : Par exemple
Code:

1 2 .Range(1,1)="B" alors la lettre B arrive en colonne B
Je regarde un peu plus près, j'ai encore dû me planter quelque part ....

J'ai résolu ce problème. Mais j'en rencontre un autre, lorsque je fais une nouvelle saisie, il me créé systématiquement une ligne vide entre la dernière saisie et la nouvelle.

Voici le code complet

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
Private Sub bouton1_Click()
Dim MonArticle As ListRow
 
    If Me.Txt_Descrip <> "" And Me.Txt_Design <> "" And Me.Txt_PAHT <> "" And Me.Txt_Stock <> "" And Me.Cmb_Fourn.ListIndex <> "" And Me.Cmb_Tva.ListIndex <> "" Then
        Sheets("Articles").ListObjects(1).ListRows.Add
 
        Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add
 
        'On ajoute les articles au tableau
        With MonArticle
        .Range(1, 1) = Me.Label_NumEnr.Caption
        .Range(1, 2) = Me.Cmb_Fourn
        .Range(1, 4) = Me.Txt_Design
        .Range(1, 5) = Me.Txt_Descrip
        .Range(1, 6) = CDbl(Me.Txt_PAHT)
        .Range(1, 7) = Me.Cmb_Tva
        .Range(1, 8) = CInt(Me.Txt_Nobre)
        .Range(1, 10) = CInt(Me.Txt_Stock)
        .Range(1, 13) = "Active"
        End With
        Set MonArticle = Nothing
 
        Sheets("Données").Range("C4") = Sheets("Données").Range("C4") + 1
 
        Me.Cmb_Fourn = ""
        Me.Txt_Design = ""
        Me.Txt_Descrip = ""
        Me.Txt_PAHT = ""
        Me.Cmb_Tva = ""
        Me.Txt_Nobre = ""
        Me.Txt_Stock = ""
        ThisWorkbook.Save
     End If
End Sub

12/04/2019, 19h48
eriiic

Bonjour,

ça parait normal, c'est ce que tu lui demandes.
Ouvre tes mirettes un peu ;-)
eric
12/04/2019, 23h08
Vba14
Bonsoir à tous,

J'ai encore des messages d'erreur :

1 - "erreur d’exécution 1004, erreur définie par l’application ou par l’objet"

2 - "L’indice n’appartiens pas à la sélection"

3 - "Erreur système & H80010108 (-2147417848). L'objet invoqué s'est déconnecté de ses clients." et là il me jette méchamment en fermant le fichier

C'est sur cette ligne qu'il y a un bug, car à chaque fois elle est surlignée en jaune
Code:

1 2 Sheets("Articles").ListObjects(1).ListRows.Add
Eriic,

Citation:

ça parait normal, c'est ce que tu lui demandes.
Ouvre tes mirettes un peu ;-)

J'ai beau ouvrir mes mirettes, je ne vois rien.
12/04/2019, 23h38
eriiic
Pourtant c'est tout au début :
Code:

1 2 Sheets("Articles").ListObjects(1).ListRows.Add Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add
Que vient faire ce 1er .ListObjects(1).ListRows.Add ?
Il n'était pas dans la proposition d'eric.
Ca tombe bien, c'est une ligne qui te fait des misères en plus...
eric
13/04/2019, 08h50
Vba14

Bonjour eriic, bonjour à tous,

Tu as raison, j'ai copié le code d'eric et je n'ai pas fait attention que ce bout de code était resté. Je n'avais pas assez ouvert mes mirettes, bon il était tard, elles commençaient à se fermer. :oops:

Merci d'avoir éclairé ma lanterne.

Bon, j'ai enlevé la ligne inutile. Mais j'ai toujours les mêmes messages d'erreurs :

1 - "La méthode ADD a échoué"

2 - Erreur système & H80010108 (-2147417848). L'objet invoqué s'est déconnecté de ses clients.

Je n'ai pas rencontré ce type de problèmes lors de 3 premières saisies....

Voici le code sans la ligne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Private Sub bouton1_Click()
Dim MonArticle As ListRow
 
    If Me.Txt_Descrip <> "" And Me.Txt_Design <> "" And Me.Txt_PAHT <> "" And Me.Txt_Stock <> "" And Me.Cmb_Fourn.ListIndex <> "" And Me.Cmb_Tva.ListIndex <> "" Then
 
        Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add
 
        'On ajoute les articles au tableau
        With MonArticle
        .Range(1, 1) = Me.Label_NumEnr.Caption
        .Range(1, 2) = Me.Cmb_Fourn
        .Range(1, 4) = Me.Txt_Design
        .Range(1, 5) = Me.Txt_Descrip
        .Range(1, 6) = CDbl(Me.Txt_PAHT)
        .Range(1, 7) = Me.Cmb_Tva
        .Range(1, 8) = CInt(Me.Txt_Nobre)
        .Range(1, 10) = CInt(Me.Txt_Stock)
        .Range(1, 13) = "Active"
        End With
        Set MonArticle = Nothing
 
        Sheets("Données").Range("C4") = Sheets("Données").Range("C4") + 1
 
        Me.Cmb_Fourn = ""
        Me.Txt_Design = ""
        Me.Txt_Descrip = ""
        Me.Txt_PAHT = ""
        Me.Cmb_Tva = ""
        Me.Txt_Nobre = ""
        Me.Txt_Stock = ""
        ThisWorkbook.Save
     End If
End Sub

PS : L'erreur se produit sur la ligne 7 du code. J'ai regardé et fouillé un peu partout sur le net et dans ce forum, apparemment beaucoup ont déjà rencontrés ce message d'erreur...

Code:

1
2
 
Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add

14/04/2019, 04h05
Invité

Citation:

Envoyé par Vba14

Bonjour,

Ci-joint, le fichier qui m'a servi à vous répondre. Regardez comment il fonctionne. Sinon, il faudrait voir comment sont organisées vos données dans votre onglet Article.

Bonjour Eric,

Merci pour votre réponse.
Voici le code tel qu'il est dans mon projet. Mais j'ai toujours le même message d'erreur. "La méthode ADD a échoué"
Je suis entrain de travailler sur une méthode où il n'y a pas Add

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Private Sub bouton1_Click()
 
Dim MonArticle As ListRow
 
        Set MonArticle = Sheets("Articles").ListObjects(1).ListRows.Add       
 
        'On ajoute les articles au tableau de la feuille "Articles"
 
        With MonArticle
 
            .Range(1, 1) = Me.Label_NumEnr.Caption
            .Range(1, 2) = Me.Cmb_Fourn
            .Range(1, 4) = Me.Txt_Design
            .Range(1, 5) = Me.Txt_Descrip
            .Range(1, 6) = CDbl(Me.Txt_PAHT)
            .Range(1, 7) = Me.Cmb_Tva
            .Range(1, 8) = CInt(Me.Txt_Nobre)
            .Range(1, 11) = CInt(Me.Txt_Stock)
            .Range(1, 13) = "Active"
 
        End With
 
        Set MonArticle = Nothing
End Sub

14/04/2019, 08h31
Invité

Citation:

Envoyé par Vba14

Si vos données ne sont pas confidentielles, mettez un fichier (zipé) en ligne.
14/04/2019, 08h53
Vba14

Mon fichier est très gros, il n'y a rien de confidentiel dedans.
Je vais essayer de vous l'envoyer, je regarde comment faire
14/04/2019, 09h09
Invité

Citation:

Envoyé par Vba14

Il n'y a peut-être pas tout à envoyer, seulement les onglets concernés, le userform et les données et les codes pour charger les combobox.
14/04/2019, 09h44
patricktoulon

re

ces erreur incompréhensibles peuvent provenir de plusieurs chose

accès au fichier lent
fichier très lourd
et mon préféré l'etat modal du userform en essayant de modifier un autre object tel qu'un tableau structuré par exemple dans un sheets (surtout avec 2016)

en début de click met un me.hide juste pour tester
si ca marche il faudra te débrouiller pour le re show ou le unload selon ton souhait
14/04/2019, 09h57
Vba14

1 pièce(s) jointe(s)

Bonjour Patrick,

Si je mets un code sans Add ça fonctionne mieux. Mais ce n'est pas le top.
Voici le fichier
Dans la feuille "Articles", il faut appuyer sur le bouton avec une plume pour ouvrir l'UF.
14/04/2019, 10h11
Invité

Citation:

Envoyé par Vba14

Le code fonctionne correctement chez moi (Excel 2010).
14/04/2019, 10h26
patricktoulon

re

re
en effet sur 2007 32 bits a part un scintillement des shapes bouton sur sheet ca fonctionne

par contre sur 2013 bits j'ai bien l'erreur et même pire j'ai un whitescreen suivi d'un crash total d'Excel avec fermeture

Voir 40 message(s) de cette discussion en une page