XL 2019 Base de données alimentée par un userform ne fonctionne pas

Yann71 · 16 Novembre 2021

Bonsoir la com, bonsoir le forum.
Me voici avec un problème récurrent. J'ai une BD alimentée par un Userform. Si ma BD est vide, je ne peux l'alimentée avec l'userform,
par contre si dans les lignes A2 et A3 j'y inscrit des données directement dans ma BD, plus de problème, je peux alimenter par la suite depuis mon l'userform.
Donc en résumé pour que tout fonctionne je dois avoir au minimum 2 lignes remplie. Donc serait-il possible de faire en sorte que tout fonctionne même si
aucune donnée n'est inscrite dans ma BD.

Merci pour votre futur aide.

cp4 · 16 Novembre 2021

Bonsoir,

Je ne suis pas très fort. Mais pour alimenter la bd à partir du formulaire, je n'ai traité que cette partie (pas la vérification de la présence du code).

VB:

Private Sub btnAjouter_Click()
    Dim i As Integer
    For i = 2 To Range("A:A").End(xlDown).Row
        If Cells(i, 1).Text = txtCode.Text Then MsgBox " Ce code est déjà attribué à " & Cells(i, 2).Value: txtCode.Text = " ": txtCode.SetFocus: Exit Sub
    Next i
    '''''''alimenter feuille''''''''''''
    Dim ws As Worksheet, NewRow As ListRow
    Set ws = Sheets("BD")
    Set NewRow = ws.ListObjects(1).ListRows.Add
    With NewRow
        .Range(1) = txtCode.Text
        .Range(2) = cboCivilité.Text
        .Range(3) = txtNom.Text
        .Range(4) = txtPrénom.Text
        .Range(5) = txtAdresse.Text
        .Range(6) = txtCP.Text
        .Range(7) = txtVille.Text
        .Range(8) = txtTéléphone1.Text
        .Range(9) = txtTéléphone2.Text
        .Range(10) = txtMail.Text
    End With
End Sub

Bonne soirée.

Yann71 · 16 Novembre 2021

cp4 à dit:

Bonsoir,

Je ne suis pas très fort. Mais pour alimenter la bd à partir du formulaire, je n'ai traité que cette partie (pas la vérification de la présence du code).

VB:

Private Sub btnAjouter_Click()
    Dim i As Integer
    For i = 2 To Range("A:A").End(xlDown).Row
        If Cells(i, 1).Text = txtCode.Text Then MsgBox " Ce code est déjà attribué à " & Cells(i, 2).Value: txtCode.Text = " ": txtCode.SetFocus: Exit Sub
    Next i
    '''''''alimenter feuille''''''''''''
    Dim ws As Worksheet, NewRow As ListRow
    Set ws = Sheets("BD")
    Set NewRow = ws.ListObjects(1).ListRows.Add
    With NewRow
        .Range(1) = txtCode.Text
        .Range(2) = cboCivilité.Text
        .Range(3) = txtNom.Text
        .Range(4) = txtPrénom.Text
        .Range(5) = txtAdresse.Text
        .Range(6) = txtCP.Text
        .Range(7) = txtVille.Text
        .Range(8) = txtTéléphone1.Text
        .Range(9) = txtTéléphone2.Text
        .Range(10) = txtMail.Text
    End With
End Sub

Bonne soirée.

Bonsoir Cp4, merci pour ton intervention. J'ai remplacer mon code par le tient, mais une erreur survient à ce niveau:

t(i, 3) = t(i, 2)

Sub GarnirListBox1()
Dim t, i&
With Sheets("BD")
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = Join(Array(0, ListBox1.Width / 2 - 10, ListBox1.Width / 2 - 10), ";")
Label1.Caption = "Nom:": Label1.Left = ListBox1.Left
Label2.Caption = "Prénom:": Label2.Left = ListBox1.Left + ListBox1.Width / 2 + 10
ListBox1.Clear
On Error Resume Next
t = .Range("a1").ListObject.DataBodyRange.Columns("c:d")
If Not IsArray(t) Then Exit Sub
ReDim Preserve t(1 To UBound(t), 1 To UBound(t) + 1)
On Error GoTo 0
For i = 1 To UBound(t)
t(i, 3) = t(i, 2)
t(i, 2) = t(i, 1)
t(i, 1) = "Ligne n° " & String(10 - Len(CStr(i + 1)), " ") & (i + 1)
Next i
ListBox1.List = t
End With
End Sub

cp4 · 16 Novembre 2021

Je commence à te montrer comment on édite un code (voir animation Gif).
Ne passe pas sur le forum (fichier trop lourd)Lien du fichier

Ensuite, on ne sait pas vraiment ce que tu veux faire. Le code que tu présentes est le tien. Je n'ai rien touché à ce formulaire. Qui est celui que tu utilises pour supprimer un client. Chez moi, je n'ai pas rencontré ce bug.

Est-ce que tu arrives à ajouter des clients en partant d'un tableau vide? C'était ta question initiale.

ChTi160 · 16 Novembre 2021

Bonsoir Yann
Bonsoir cp4
Édit : Yann je crois que tu es entre de bonnes mains !
Bonne fin de Journée
jean marie

Yann71 · 16 Novembre 2021

ChTi160 à dit:
Bonsoir Yann
Bonsoir cp4
je constate une anomalie parmi tant d'autres Lol
tu as

donc 2 colonnes c et d
et tu fais

je pense que tu veux ajouter une colonne a ton tableau"t"
et bien pour modifier le Nombre de Colonnes il faut travailler sur la dimension

donc mettre
1 To UBound(t,2) + 1
soit

Bonne fin de Journée
jean marie

Bonsoir Jean-Marie, comment vas-tu ?
Merci pour ton intervention. Après avoir modifier la ligne de code par la tienne, mon Userform 1 ne s'ouvre plus qu'à mon Userform 2 aucun problème.

ChTi160 · 16 Novembre 2021

Re
Yann
Afin de ne pas ( comme disait Coluche) t'introduire par erreur !
J'ai supprimé toutes les anneries que j'avais pu commettre sur ce fil lol
Bonne journée
A bientôt sur des fils ou je pourrai t'aider.

jean marie

ChTi160 · 16 Novembre 2021

Re
Afin de ne pas ( comme disait Coluche) t'introduire par erreur !
J'ai supprimé toutes les anneries que j'avais pu commettre sur ce fil lol
Bonne journée
A bientôt sur des fils ou je pourrai t'aider.
Jean marie

Dranreb · 16 Novembre 2021

Bonsoir.
Inspirez vous donc plutôt de celui-ci, il est presque pareil.

AtTheOne · 17 Novembre 2021

Ajout : Pour Yann71
Bonne nuit,
Après la télé EXCEL !
Désolé, je ne pédale pas très vite, j'en suis à répondre au 1er post !

Ton problème, quand tu as supprimé (je dis bien supprimé, pas effacé) la seule ligne qui reste dans ton tableau, c'est que Listrows.Count vaut 0, que les DataBodyRange ne sont plus définis et que Lisrows(1) renvoie une erreur "l'indice n'appartient pas à la sélection".
Cela plante le formulaire ...
Je prends des précautions sur les tableaux vides et je ramène le cas 1 seule ligne vide à aucune ligne.

J'ai modifié les codes

Dans Userform1
btn_Ajouter
btn_Annuler
btn_Modifier
Userform_Initialize
affiche
J'ai ajouté Charger_Combo

Dans Userform2
CommandButton1_Click
GarnirListBox1

Plus le courage de regarder le reste.
C'est vraiment l'heure de se coucher.

A bientôt
Alain

Dranreb · 17 Novembre 2021

Pour info: Mon objet ComboBoxLiées, qui prend à son compte la collection ListRows du ListObject en tant que propriété Lignes, n'est pas géné s'il est vide. Sa méthode Plage prends toutefois toujours au moins 2 lignes derrière la HeaderRowRange. Ça n'a pas posé de problème jusqu'à présent.
Sa méthode Actualiser, qui établit les listes complètes au niveau base, n'emploie DataBodyRange que si Lignes.Count > 1

AtTheOne · 17 Novembre 2021

On ne se couche pas !
Salut Dranreb
Comme je le disais dans mon post, qui s'adresse plutôt à Yann71, je répondais au post du début. Je suis un peu lent et je n'ai pas encore épluché les posts suivants.
Donc ma réponse tentait d'expliquer le plantage du premier fichier de Yann71 quand il avait supprimé toutes les lignes de son tableau.
Ceci sans révolutionner l'ensemble de son projet.
Promis je regarde ton projet plus tard, après un peu de sommeil et je te fais un retour.
A bientôt
Alain

cp4 · 17 Novembre 2021

Dranreb à dit:
Bonsoir.
Inspirez vous donc plutôt de celui-ci, il est presque pareil.

Bonjour à toutes et à tous,

@Dranreb : Connaissant ton haut niveau de codage, j'ai ouvert ton fichier et à ma déception le code plante (sous Excel 2010 ou plutôt 2007 mis à niveau vers 2010)

Dranreb · 17 Novembre 2021

Bonjour.
Ça doit être à cause d'une options 'Arrêt sur toutes les erreurs' cochée à tort dans VBE, menu Outils, Options…, onglet Général, rubrique Récupération d'erreur. Cochez donc plutôt 'Arrêt dans le module de classe'.

cp4 · 17 Novembre 2021

Dranreb à dit:
Bonjour.
Ça doit être à cause d'une options 'Arrêt sur toutes les erreurs' cochée à tort dans VBE, menu Outils, Options…, onglet Général, rubrique Récupération d'erreur. Cochez donc plutôt 'Arrêt dans le module de classe'.

C'est parfait. Merci beaucoup.

XL 2019 Base de données alimentée par un userform ne fonctionne pas

Yann71

XLDnaute Occasionnel

Pièces jointes

cp4

XLDnaute Barbatruc

Yann71

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Yann71

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Pièces jointes

AtTheOne

XLDnaute Accro

Pièces jointes

Dranreb

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

cp4

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Discussions similaires