Discussion :

[bruthe]

Bonjour

Ci-dessous un exemple
Je voudrais insérer des lignes dans un tableau sous via un formulaire
J'ai plusieurs tableaux dans une feuille
quelqu'un pourrait-il m'aider ou me donner une piste SVP
Merci
test1

type	DESIGNATION DUMATERIEL	NUMERO DE SERIE
ordi1	box1	BG02326
ordi2	box2	GC12ZF2
ordi3	box3	97Y0ZF2

test2

TYPE	DESIGNATION DUMATERIEL	NUMERO DE SERIE
ordinateur Portable1	mat 1	PS#004167
Ordinateur Portable2	mat2	PF1HDYN4

[Pierre Fauconnier]

Salut.

J'ai modélisé cela dans cette contribution. J'espère qu'elle pourra t'aider.

[boisgontierjacques]

Bonjour,

C'est un programme générique qui s'adapte à la BD.
Vous pouvez ajouter des colonnes dans la BD
Le tableau peut être vide au départ.
Il suffit de coller la BD en A1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 Option Compare Text
Dim nomtableau, TblBD(), NbCol
 
Private Sub UserForm_Initialize()
 nomtableau = "Tableau1"
 NbCol = Range(nomtableau).Columns.Count
 TblBD = Range(nomtableau).Resize(, NbCol + 1).Value              ' Array: + rapide
 For i = 1 To UBound(TblBD): TblBD(i, NbCol + 1) = i: Next i      ' No enregistrement
 LabelsTextBox
 If Range(nomtableau).Item(1, 1) <> "" Then n = Range(nomtableau).Rows.Count + 1 Else n = 1
 Me.enreg = n
 Me.TextBox1 = Application.Max(Range(nomtableau).Columns(1)) + 1
 Tri TblBD, LBound(TblBD), UBound(TblBD), 2
 Me.Recherche.List = TblBD
 TextBoxRecherche_Change
End Sub
 
Private Sub Recherche_Change()
  Me.enreg = Application.Match(Val(Me.Recherche), Range(nomtableau).Columns(1), 0)
  Me.TextBox1 = Me.Recherche
  For i = 2 To NbCol
     Me("textbox" & i) = Range(nomtableau).Item(enreg, i)
  Next i
End Sub
 
Private Sub B_précédent_Click()
 If Me.Recherche.ListIndex > 0 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex - 1
 End If
End Sub
 
Private Sub B_suivant_Click()
 If Me.Recherche.ListIndex < Me.Recherche.ListCount - 1 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex + 1
 End If
End Sub
 
Private Sub B_valid_Click()
  enreg = Me.enreg
  For c = 1 To NbCol
   If Not Range(nomtableau).Item(enreg, c).HasFormula Then
     tmp = Me("textbox" & c)
     If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
        tmp = Replace(tmp, ".", ",")
        Range(nomtableau).Item(enreg, c) = CDbl(tmp)
     Else
         If IsDate(tmp) Then
           Range(nomtableau).Item(enreg, c) = CDate(tmp)
         Else
           Range(nomtableau).Item(enreg, c) = tmp
         End If
     End If
    Else
     Range(nomtableau).Item(enreg - 1, c).Copy
     Range(nomtableau).Item(enreg, c).PasteSpecial Paste:=xlPasteFormats
    End If
  Next c
  raz
  UserForm_Initialize
End Sub
 
Private Sub B_sup_Click()
  If MsgBox("Etes vous sûr de supprimer " & Me.TextBox2 & "?", vbYesNo) = vbYes Then
     Range(nomtableau).Rows(Me.enreg).Delete
     Me.Recherche.List = Range(nomtableau).Value
  End If
End Sub
 
Private Sub B_ajout_Click()
  raz
  If Range(nomtableau).Item(1, 1) <> "" Then n = Range(nomtableau).Rows.Count + 1 Else n = 1
  Me.enreg = n
  Me.TextBox1 = Application.Max(Range(nomtableau).Columns(1)) + 1
End Sub
 
Sub raz()
 For i = 1 To NbCol
   Me("textbox" & i) = ""
 Next i
End Sub
 
Sub LabelsTextBox()
   For c = 1 To NbCol
      Me("textbox" & c).Width = Range(nomtableau).Columns(c).Width * 1.3
      tmp = Range(nomtableau).Offset(-1).Item(1, c)
      Me("label" & c).Caption = tmp
      lg = Len(tmp): If Len(tmp) > 20 Then lg = 20
      Me("label" & c).Width = lg * 8
   Next
   For i = NbCol + 1 To 15: Me("label" & i).Visible = False: Me("textbox" & i).Visible = False: Next i
End Sub
 
Private Sub Listbox1_Click()
  ligneEnreg = Me.ListBox1.Column(3)
  Me.enreg = ligneEnreg
  For k = 1 To NbCol
    Me("textbox" & k) = Range(nomtableau).Item(ligneEnreg, k)
  Next k
End Sub
 
Private Sub TextBoxRecherche_Change()
  colRecherche = 1
  colRecherche2 = 2
  colRecherche3 = 3
  clé = Me.TextBoxRecherche & "*": n = 0
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Or TblBD(i, colRecherche2) Like clé _
       Or TblBD(i, colRecherche3) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To 4, 1 To n)
        Tbl(1, n) = TblBD(i, colRecherche): Tbl(2, n) = TblBD(i, colRecherche2)
        Tbl(3, n) = TblBD(i, colRecherche3)
        Tbl(4, n) = TblBD(i, NbCol + 1)
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Boisgontier

[mfoxy]

Bonjour Jacques,

Joli travail de généralisation, J'achète :-)

Cependant si je peux me permettre :

- J'aurais apprécié que le code soit documenté, il est assez complexe même en mode pas à pas de suivre le cheminement de vos codes.
- Il y a aussi des bug, par exemple lorsque l'utilisateur tente d'effectuer certaine action si le tableau est vide.
- Ne serait-il pas judicieux de mettre les procédures ( par exemple : tris, LabelsTextBox,...) dans un module que dans le code du Usf ?

Bàv

MFoxy

[Pierre Fauconnier]

Bonjour,

C'est un programme générique qui s'adapte à la BD.[...]

Qui s'adapte à la DB?

• Le nom du tableau est en dur, ça oblige à utiliser des noms de textbox et de label "tetxboxXX" et "labelXX";
• ça impose qu'il y ait forcément quelque chose dans la première cellule du tableau (Si rien dans cette cellule, l'ajout d'une ligne via le userform écrase cette ligne);
• Il faut que le textbox1 contienne le max de la colonne1 du tableau +1 (qui doit donc être numérique => En quoi est-ce générique? Qu'est-ce qui impose que la première colonne soit numérique? Qu'est-ce qui impose que les valeurs de cette colonne soient uniques (surtout dans Excel qui ne gère pas les clés primaires)?, etc, etc, etc?);
• Ca charge la première ligne du tableau, l'index 1 étant spécifié en hard coding (à ne jamais faire, le hard coding), dans l'initialize;
• La procédure Initialize ne devrait JAMAIS servir à manipuler des données métier (numéro de la ligne chargée, comme ici, ...) sinon, on n'est FORCEMENT plus générique! En fait, on ne devrait pratiquement jamais utiliser Initialize, surtout dans un brol que l'on veut générique!, sinon ben... il n'est plus générique, évidemment;
• S'il y a plus que 15 colonnes dans le tableau, on fait quoi (Plantage!)?
• Il n'y a pas de Option Explicit (alors que c'est impératif, pour moi);
• Les contrôles se redimensionnent en fonction de la largeur des colonnes, et donc se "tapent dedans" si les colonnes sont trop larges
• ...

Où est le "générique" dans cette solution? Il n'y a pas de gestion d'erreur, et comme je ne vois nulle part que tu ajoutes les textbox et label de façon dynamique, ça veut dire que si on en oublie un ou qu'on ne les nomme pas en fonction de l'organisation du tableau (colonne = Textbox etc), c'est le plantage assuré. Si on modifie l'ordre des colonnes par la suite, on est bon pour repasser tout le code en revue.

Règle de base à l'attention du débutant: Ne jamais organiser ton userform en fonction de l'ordre des colonnes du tableau. C'est une règle de base à ne jamais contourner.
Autre règle de base: ne JAMAIS utiliser (ou presque, et encore) la procédure Initialize d'un userform.

[bruthe]

Tout d'abord merci pour vos réponses
Je m'explique plus clairement avec mon modèle de formulaire



Lorsque je valide test1 par exemple l'entrée des données doit se faire dans le tableau test1
Lorsque je valide test2 l'entrée des données doit se faire dans le tableau test2
etc …

En attendant je vais déjà travailler sur ce que vous m'avez envoyé

merci

[boisgontierjacques]

Voici le formulaire pour les 3 tableaux

Les 3 tableaux peuvent avoir des structures différentes.
L'ordre des colonnes des BD n'a pas d'importance.
Ils sont nommés test1,test2,test3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Option Compare Text
Dim nomtableau, TblBD(), NbCol
 
Private Sub UserForm_Initialize()
 nomtableau = Sheets("Accueil").[A1]
 Me.LabFichier.Caption = nomtableau
 NbCol = Range(nomtableau).Columns.Count
 TblBD = Range(nomtableau).Resize(, NbCol + 1).Value              ' Array: + rapide
 For i = 1 To UBound(TblBD): TblBD(i, NbCol + 1) = i: Next i      ' No enregistrement
 LabelsTextBox
 If Range(nomtableau).Item(1, 1) <> "" Then n = Range(nomtableau).Rows.Count + 1 Else n = 1
 Me.enreg = n
 Me.TextBox1 = Application.Max(Range(nomtableau).Columns(1)) + 1
 Tri TblBD, LBound(TblBD), UBound(TblBD), 2
 Me.Recherche.List = TblBD
 TextBoxRecherche_Change
End Sub
 
Private Sub Recherche_Change()
  Me.enreg = Application.Match(Val(Me.Recherche), Range(nomtableau).Columns(1), 0)
  Me.TextBox1 = Me.Recherche
  For i = 2 To NbCol
     Me("textbox" & i) = Range(nomtableau).Item(enreg, i)
  Next i
End Sub
 
Private Sub B_précédent_Click()
 If Me.Recherche.ListIndex > 0 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex - 1
 End If
End Sub
 
Private Sub B_suivant_Click()
 If Me.Recherche.ListIndex < Me.Recherche.ListCount - 1 Then
    Me.Recherche.ListIndex = Me.Recherche.ListIndex + 1
 End If
End Sub
 
Private Sub B_valid_Click()
  enreg = Me.enreg
  For c = 1 To NbCol
   If Not Range(nomtableau).Item(enreg, c).HasFormula Then
     tmp = Me("textbox" & c)
     If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
        tmp = Replace(tmp, ".", ",")
        Range(nomtableau).Item(enreg, c) = CDbl(tmp)
     Else
         If IsDate(tmp) Then
           Range(nomtableau).Item(enreg, c) = CDate(tmp)
         Else
           Range(nomtableau).Item(enreg, c) = tmp
         End If
     End If
    Else
     Range(nomtableau).Item(enreg - 1, c).Copy
     Range(nomtableau).Item(enreg, c).PasteSpecial Paste:=xlPasteFormats
    End If
  Next c
  raz
  UserForm_Initialize
End Sub
 
Private Sub B_sup_Click()
  If MsgBox("Etes vous sûr de supprimer " & Me.TextBox2 & "?", vbYesNo) = vbYes Then
     Range(nomtableau).Rows(Me.enreg).Delete
     Me.Recherche.List = Range(nomtableau).Value
  End If
End Sub
Private Sub B_ajout_Click()
  raz
  If Range(nomtableau).Item(1, 1) <> "" Then n = Range(nomtableau).Rows.Count + 1 Else n = 1
  Me.enreg = n
  Me.TextBox1 = Application.Max(Range(nomtableau).Columns(1)) + 1
End Sub
Sub raz()
 For i = 1 To NbCol
   Me("textbox" & i) = ""
 Next i
End Sub
 
Sub LabelsTextBox()
   For c = 1 To NbCol
      Me("textbox" & c).Width = Range(nomtableau).Columns(c).Width * 1.3
      tmp = Range(nomtableau).Offset(-1).Item(1, c)
      Me("label" & c).Caption = tmp
      lg = Len(tmp): If Len(tmp) > 20 Then lg = 20
      Me("label" & c).Width = lg * 8
   Next
   For i = NbCol + 1 To 15: Me("label" & i).Visible = False: Me("textbox" & i).Visible = False: Next i
End Sub
 
Private Sub Listbox1_Click()
  ligneEnreg = Me.ListBox1.Column(3)
  Me.enreg = ligneEnreg
  For k = 1 To NbCol
    Me("textbox" & k) = Range(nomtableau).Item(ligneEnreg, k)
  Next k
End Sub
 
Private Sub TextBoxRecherche_Change()
  colRecherche = 1
  colRecherche2 = 2
  colRecherche3 = 3
  clé = Me.TextBoxRecherche & "*": n = 0
  Dim Tbl()
  For i = 1 To UBound(TblBD)
    If TblBD(i, colRecherche) Like clé Or TblBD(i, colRecherche2) Like clé _
       Or TblBD(i, colRecherche3) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To 4, 1 To n)
        Tbl(1, n) = TblBD(i, colRecherche): Tbl(2, n) = TblBD(i, colRecherche2)
        Tbl(3, n) = TblBD(i, colRecherche3)
        Tbl(4, n) = TblBD(i, NbCol + 1)
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Boisgontier

[Pierre Fauconnier]

@Bruthe,

Note que des codes tels que ceux proposés dans la "solution" qui t'a été proposée, outre la syntaxe à crochets dont j'ai déjà parlé et que les aficionados sont infoutus de justifier sur le plan technique, imposent une feuille dont le nom d'onglet est "Accueil", et qui reçoit le choix "Test1" etc en dur et en A1, ce qui est évidemment une très mauvais pratique. On ne met JAMAIS en hardcoding des notions qui peuvent être modifiées dans l'interface.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub afficheformSaisieTest1()
  Sheets("Accueil").[A1] = "test1"
  UserFormSaisie.Show
End Sub
Sub afficheformSaisieTest2()
  Sheets("Accueil").[A1] = "test2"
  UserFormSaisie.Show
End Sub
Sub afficheformSaisieTest3()
  Sheets("Accueil").[A1] = "test3"
  UserFormSaisie.Show
End Sub

De plus, il n'est nullement utile de mettre ce genre de truc en place pour que le userform bascule d'un tableau à l'autre. Par contre, tu parles de "test1", "test2", etc... Il me semble dès lors peu pertinent de mettre cela en dur dans ton userform avec des cases à cocher...

Pourrais-tu nous dire, en français et sans jargon Excel ou VBA, ce que tu souhaites réaliser?

[mfoxy]

Je me permet une petite parenthèse à l'intention de Jacques Boisgontier,

Bonjour Monsieur Jacques,


Je tenais à vous remercier pour vos jolis Pièce jointe 555752 , ceux-ci répondent parfaitement et de manière très constructives à mes interrogations, qui étaient données uniquement dans le but de m'instruire et de tenter de comprendre votre code.

Au vus des commentaires laissés par des membres des plus compétent de ce forum, qui par leur approche professionnelle ,pédagogique et perenne de coder , mon permis de m'initier à un codage qualitatif et généralisable.Je me rend compte que mes doutes/questions sur votre "code générique", qui ceci dit relève plus du Hard Coding , était la bonne, il semble bien foutu de prime abord mais en grattant et testant c'est une autre histoire.

Je vous remercie du temps que vous aurez pris à affubler ce petit billet d'humeur de votre rouge signature, après je l'espère sa lecture , et vous retourne ce même compliment de bon coeur.

"L'entêtement sans intelligence, c'est la sottise soudée au bout de la bêtise et lui servant de rallonge."
Victor Hugo