Discussion :

[loune50]

Bonjour a tous,

Alors voila je viens vers vous car je continue mon projet de gestion de base de donnée j'ai eu un coup de main de Daniel.C que je remercie beaucoup,
maintenant j'ai un autre petit souci j'ai des bouton modifier et supprimer qui ne fonctionne pas ou mal donc je viens vous demandez de l'aide .

j'ai un textbox de recherche avec un bouton valide (merci Daniel) qui remplit une listbox, quand je clique sur une ligne les données s'affichent dans des textbox et combobox j'aimerai pouvoir modifer et pouvoir supprimer mais que ca le fasse aussi sur ma base excel . j'ai essayer plusieurs méthode et en lisant certain sujet j'ai réussit a faire certaine chose (ajouter)mais le reste ca ne fonctionne pas correctement est ce que je peux vous demandez un petit peu d'aide s'il vous plait.et me dire deja si tout les codes inscrit sont bon ??

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
Option Base 1
 
 
 
Private Sub CommandButton1_Click()
With Sheets("Clients")
  DerLg = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A" & DerLg + 1) = TextBoxfor
  .Range("B" & DerLg + 1) = TextBoxdes
  .Range("C" & DerLg + 1) = ComboBoxcon
  .Range("D" & DerLg + 1) = TextBoxlot
  .Range("E" & DerLg + 1) = TextBoxqua
  .Range("F" & DerLg + 1) = CDate(TextBoxfab)
  .Range("G" & DerLg + 1) = CDate(TextBoxfin)
  .Range("H" & DerLg + 1) = ComboBoxzon
  .Range("I" & DerLg + 1) = TextBoxall
  .Range("J" & DerLg + 1) = TextBoxcom
  .Range("K" & DerLg + 1) = TextBox7
  .Range("L" & DerLg + 1) = TextBox5
  Set plg = .Range("A2:L" & .Range("A" & .Rows.Count).End(xlUp).Row)
  plg.Columns.AutoFit
  Me.Width = ListBox1.Width + 20
  TbEntier = plg
End With
End Sub
 
Private Sub CommandButton2_Click()
Dim DerLig As Long
  If MsgBox("Voulez vous envoyer vers planning ?", 36, "Création") = vbYes Then
 
    DerLig = Sheets("Feuil3").Range("A65000").End(xlUp).Row + 1
 
    Range(Cells(DerLig - 1, 1), Cells(DerLig - 1, 40)).Copy
    Cells(DerLig, 1).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
 
 
        Sheets("Feuil3").Cells(DerLig, 1) = TextBoxfor.Value
        Sheets("Feuil3").Cells(DerLig, 2) = TextBoxdes.Value
        Sheets("Feuil3").Cells(DerLig, 3) = ComboBoxcon.Value
        Sheets("Feuil3").Cells(DerLig, 4) = TextBoxlot.Value
        Sheets("Feuil3").Cells(DerLig, 5) = TextBoxqua.Value
        Sheets("Feuil3").Cells(DerLig, 6) = CDate(TextBoxfab.Value)
        Sheets("Feuil3").Cells(DerLig, 7) = CDate(TextBoxfin.Value)
        'Sheets("Feuil3").Cells(DerLig, 8) = ComboBoxzon.Value
        Sheets("Feuil3").Cells(DerLig, 8) = TextBoxall.Value
        Sheets("Feuil3").Cells(DerLig, 9) = ComboBoxlig
        Sheets("Feuil3").Cells(DerLig, 10) = CDate(TextBoxcon.Value)
 
  End If
 
 
 
End Sub
 
Private Sub CommandButton7_Click()
    Dim S As String, i As Long, L As Long, Nbr As Long, k As Long
    Dim C As Range, ResAdr As String, Sh As Worksheet
    Dim tbPartiel()
    Dim Tabl As Variant
    Me.ListBox1.Clear
    If TextBoxrec = "" Then
      ListBox1.List = TbEntier
      Exit Sub
    End If
    Set Sh = Sheets("Clients")
    Tabl = Split(Me.TextBoxrec.Text, ";")
    With Me.ListBox1
        For Each Item In Tabl
            Set C = Sh.[A:A].Find(Item, , , xlWhole)
            If Not C Is Nothing Then
                ResAdr = C.Address
                Do
                    .AddItem C.Value
                    For i = 1 To 11
                        .List(.ListCount - 1, i) = C.Offset(, i)
                    Next i
                    Var = .List
                    Set C = Sh.[A:A].FindNext(C)
                Loop While C.Address <> ResAdr
            End If
        Next Item
    End With
 
End Sub
 
 
 
Private Sub TextBoxrec_Change()
Dim S As String, i As Long, L As Long, Nbr As Long, k As Long
Dim tbPartiel()
nbrecol = 12
If TextBoxrec = "" Then
  ListBox1.List = TbEntier
Else
L = 1
  ReDim Preserve tbPartiel(UBound(TbEntier, 1), nbrecol)
  For i = 1 To UBound(TbEntier, 1)
    For k = 1 To nbrecol
      If UCase(TbEntier(i, k)) Like "*" & UCase(TextBoxrec) & "*" Then
        For Nbr = 1 To 12
          tbPartiel(L, Nbr) = TbEntier(i, Nbr)
        Next Nbr
        L = L + 1
        Exit For
      End If
    Next k
  Next i
  Me.Repaint
  ListBox1.List = tbPartiel
End If
End Sub
 
Private Sub UserForm_Initialize()
Dim cw
With Sheets("Clients")
  Set plg = .Range("A2:L" & .Range("A" & .Rows.Count).End(xlUp).Row)
  plg.Columns.AutoFit
  ListBox1.Width = 20 + plg.Width
  Me.Width = ListBox1.Width + 20
  TbEntier = plg
End With
With ListBox1
  cw = ""
  .ColumnCount = plg.Columns.Count
  .List = TbEntier
  For i = 1 To .ColumnCount
    cw = cw & plg.Columns(i).Width & ";"
    Next
  .ColumnWidths = cw
  .ListIndex = -1
End With
 
ComboBoxcon.Clear
ComboBoxzon.Clear
ComboBoxlig.Clear
 
ComboBoxcon.AddItem "Conforme"
ComboBoxcon.AddItem "Non-Conforme"
ComboBoxcon.AddItem "En Attente"
 
ComboBoxzon.AddItem "Conforme"
ComboBoxzon.AddItem "Non-Conforme"
ComboBoxzon.AddItem "Preparation"
ComboBoxzon.AddItem "Controle"
ComboBoxzon.AddItem "Recontrole"
 
ComboBoxlig.AddItem "Ratio 1"
ComboBoxlig.AddItem "Ratio 2"
ComboBoxlig.AddItem "Ratio 3"
ComboBoxlig.AddItem "Ratio 4"
ComboBoxlig.AddItem "Ratio 5"
ComboBoxlig.AddItem "Ratio 6"
ComboBoxlig.AddItem "MLB"
ComboBoxlig.AddItem "KALIX"
ComboBoxlig.AddItem "Stoppil 3"
ComboBoxlig.AddItem "Stoppil 4"
ComboBoxlig.AddItem "Serac 2"
ComboBoxlig.AddItem "Serac 3"
ComboBoxlig.AddItem "Stoppil 2"
 
End Sub
 
Sub ListBox1_Click()
 
Dim i As Integer
 
i = ListBox1.ListIndex
Row = ListBox1.ListIndex + 2
 
TextBoxfor.Text = ListBox1.List(i, 0)
TextBoxdes.Text = ListBox1.List(i, 1)
ComboBoxcon.Text = ListBox1.List(i, 2)
TextBoxlot.Text = ListBox1.List(i, 3)
TextBoxqua.Text = ListBox1.List(i, 4)
TextBoxfab.Text = CDate(ListBox1.List(i, 5))
TextBoxfin.Text = CDate(ListBox1.List(i, 6))
ComboBoxzon.Text = ListBox1.List(i, 7)
TextBoxall.Text = ListBox1.List(i, 8)
TextBoxcom.Text = ListBox1.List(i, 9)
 
End Sub

[Daniel.C]

Bonjour Sylvain,

Sans classeur, ça va être difficile de t'aider. Je poste donc le classeur tel qu'il est maintenant. Si quelqu'un ne peut pas décompresser le classeur, je le posterai décompressé.

Quels sont les champs permettant d'identifier une ligne unique en vue de sa suppression ? Est-ce que, par exemple le n° de formule et la désignation suffisent ? ou est-ce qu'il faut vérifier tous les champs ?

Bonjour, j'ai ajouté ou modifié les macros suivantes :

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
Private Sub CommandButton5_Click()
    'suppression de ligne
    Dim Plage As Range, DatFab As String, DatFin As String, C As Range
    With Sheets("Clients")
        Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 12)
        .AutoFilterMode = False
        Plage.AutoFilter 1, Me.TextBoxfor.Text
        Plage.AutoFilter 2, Me.TextBoxdes.Text
        Plage.AutoFilter 3, Me.ComboBoxcon.Text
        Plage.AutoFilter 4, Me.TextBoxlot.Text
        Plage.AutoFilter 5, Me.TextBoxqua.Text
        d = Me.TextBoxfab.Text
        DatFab = Mid(d, 4, 2) & "/" & Left(d, 2) & "/" & Right(d, 2)
        Plage.AutoFilter 6, ">=" & DatFab, xlAnd, "<=" & DatFab
        d = Me.TextBoxfin.Text
        DatFin = Mid(d, 4, 2) & "/" & Left(d, 2) & "/" & Right(d, 2)
        Plage.AutoFilter 7, ">=" & DatFin, xlAnd, "<=" & DatFin
        Plage.AutoFilter 8, Me.ComboBoxzon.Text
        Plage.AutoFilter 9, Me.TextBoxall.Text
        Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1)
        If Application.Subtotal(103, Plage) > 0 Then
            Set Plage = Plage.SpecialCells(xlCellTypeVisible)
            For Each C In Plage
                C.EntireRow.Delete
            Next C
        End If
        .AutoFilterMode = False
    End With
End Sub

Code :

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

1
2
3
4
5
6
Private Sub Workbook_Open()
 
Sheets("Clients").AutoFilterMode = False
UserForm1.Show
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButmod_Click()
    'modification de ligne
    With Sheets("Clients")
        .Cells(Ligne, 1) = Me.TextBoxfor.Text
        .Cells(Ligne, 2) = Me.TextBoxdes.Text
        .Cells(Ligne, 3) = Me.ComboBoxcon.Text
        .Cells(Ligne, 4) = Me.TextBoxlot.Text
        .Cells(Ligne, 5) = Me.TextBoxqua.Text
        .Cells(Ligne, 6) = Me.TextBoxfab.Text
        .Cells(Ligne, 7) = Me.TextBoxfin.Text
        .Cells(Ligne, 8) = Me.ComboBoxzon.Text
        .Cells(Ligne, 9) = Me.TextBoxall.Text
    End With
End Sub

et :

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
Sub ListBox1_Click()
 
Dim i As Integer
 
i = ListBox1.ListIndex
Row = ListBox1.ListIndex + 2
 
TextBoxfor.Text = ListBox1.List(i, 0)
TextBoxdes.Text = ListBox1.List(i, 1)
ComboBoxcon.Text = ListBox1.List(i, 2)
TextBoxlot.Text = ListBox1.List(i, 3)
TextBoxqua.Text = ListBox1.List(i, 4)
TextBoxfab.Text = CDate(ListBox1.List(i, 5))
TextBoxfin.Text = CDate(ListBox1.List(i, 6))
ComboBoxzon.Text = ListBox1.List(i, 7)
TextBoxall.Text = ListBox1.List(i, 8)
TextBoxcom.Text = ListBox1.List(i, 9)
    Dim Plage As Range, DatFab As String, DatFin As String, C As Range
With Sheets("Clients")
    Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 12)
    .AutoFilterMode = False
    Plage.AutoFilter 1, Me.TextBoxfor.Text
    Plage.AutoFilter 2, Me.TextBoxdes.Text
    Plage.AutoFilter 3, Me.ComboBoxcon.Text
    Plage.AutoFilter 4, Me.TextBoxlot.Text
    Plage.AutoFilter 5, Me.TextBoxqua.Text
    d = Me.TextBoxfab.Text
    DatFab = Mid(d, 4, 2) & "/" & Left(d, 2) & "/" & Right(d, 2)
    Plage.AutoFilter 6, ">=" & DatFab, xlAnd, "<=" & DatFab
    d = Me.TextBoxfin.Text
    DatFin = Mid(d, 4, 2) & "/" & Left(d, 2) & "/" & Right(d, 2)
    Plage.AutoFilter 7, ">=" & DatFin, xlAnd, "<=" & DatFin
    Plage.AutoFilter 8, Me.ComboBoxzon.Text
    Plage.AutoFilter 9, Me.TextBoxall.Text
    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1)
    If Application.Subtotal(103, Plage) > 0 Then
        Set Plage = Plage.SpecialCells(xlCellTypeVisible)
        Ligne = Plage.Row
    End If
    .AutoFilterMode = False
End With
End Sub

[loune50]

Bonjour,

Encore une fois merci de prendre le temps de me répondre, désolé pour hier j'étais obligé de m'absenter.
j'ai essayé les codes et de comprendre mais c'est pas facile et du coup effectivement je me rend compte d'une difficulté soulevé..
Comment quand il y a 8 lignes identiques reconnait il celle a supprimé car certaine ligne peuvent être identique d'autre avoir juste la quantité ou le numéro de lot qui change ou l'allée, dans ce cas comment faire est ce que le vba nous permet de compter les lignes recherché ou dois je mettre une colonne supplémentaire qui compte les lignes identique ( exemple, 1/1, 1/2, 1/3 )ce qui pour moi peux présenter un autre avantage( mais long de tout reprendre )
a court terme j'aimerai pouvoir compter combien de ligne et combien en quantité il peut y avoir pour une même référence qui puissent s'afficher dans un textbox ( plus tard bien sur ).

J'ai vu pour certain code des personnes qui rajouter un onglet qui je crois permet de compter ?? est ce possible .

Merci encore.

[Daniel.C]

J'ai procédé différemment pour les suppressions et pour les modifs. Pour les suppressions, j'ai supprimé toutes les lignes. Pour les modifs, j'ai cherché le numéro de la première ligne trouvée, et c'est elle que j'ai modifiée. Il n'y aurait pas de problème si l'on ne faisait les modifs ou suppressions lorsque la listbox contient toutes lignes. Mais si tu as fait une recherche préalable, ça ne fonctionne plus. Une solution serait d'ajouter une colonne cachée dans la listbox contenant le numéro de la ligne. Dis-moi si tu es d'accord avec cette approche. Je la mettrais en application dès que possible.
Ca me fait plaisir que tu cherches à comprendre le code; ce n'est pas si fréquent. Quand il sera au point, je le commenterai. Actuellement, j'utilise un filtre automatique pour trouver les enregistrements. Je filtre sur tous les textboxes avec un petit bidouillage pour pouvoir filtrer sur les dates.

[loune50]

oui je pense effectivement que cela serait la meilleur solution je te remercie pour cette solution tout indiqué je continue d'essayer de comprendre par moi meme en attendant ton descriptif

Merci encore et encore aussi .

[Daniel.C]

... Le temps de mettre le rôti au four, j'ai pensé... Es-tu sûr qu'il y puisse y avoir plusieurs lignes avec les mêmes valeurs des 9 textboxes ?
PS. Je viens de lire ta réponse au message précédent. OK, on marche comme ça.

Bon, voici les macros modifiées :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_Open()
Dim C As Range
With Sheets("Clients")
    .AutoFilterMode = False
    Set plg = .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 12)
    For Each C In plg
        C.Value = C.Row
    Next C
    .Columns(13).Hidden = True
End With
UserForm1.Show
End Sub

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
Private Sub CommandButmod_Click()
    'modification de ligne
    With Me.ListBox1
        Ligne = .List(.ListIndex, 12)
    End With
    With Sheets("Clients")
        .Cells(Ligne, 1) = Me.TextBoxfor.Text
        .Cells(Ligne, 2) = Me.TextBoxdes.Text
        .Cells(Ligne, 3) = Me.ComboBoxcon.Text
        .Cells(Ligne, 4) = Me.TextBoxlot.Text
        .Cells(Ligne, 5) = Me.TextBoxqua.Text
        .Cells(Ligne, 6) = Me.TextBoxfab.Text
        .Cells(Ligne, 7) = Me.TextBoxfin.Text
        .Cells(Ligne, 8) = Me.ComboBoxzon.Text
        .Cells(Ligne, 9) = Me.TextBoxall.Text
    End With
    With Sheets("Clients")
        Set plg = .Range("A2:M" & .Range("A" & .Rows.Count).End(xlUp).Row)
        TbEntier = plg
    End With
    With Me.ListBox1
        .List = TbEntier
        Me.Repaint
    End With
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton5_Click()
    'suppression de ligne
    With Me.ListBox1
        Sheets("Clients").Rows(.List(.ListIndex, 12)).Delete
    End With
    With Sheets("Clients")
        Set plg = .Range("A2:M" & .Range("A" & .Rows.Count).End(xlUp).Row)
        TbEntier = plg
    End With
    With Me.ListBox1
        .List = TbEntier
        Me.Repaint
    End With
End Sub

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
Sub ListBox1_Click()
 
Dim i As Integer
 
i = ListBox1.ListIndex
Row = ListBox1.ListIndex + 2
 
TextBoxfor.Text = ListBox1.List(i, 0)
TextBoxdes.Text = ListBox1.List(i, 1)
ComboBoxcon.Text = ListBox1.List(i, 2)
TextBoxlot.Text = ListBox1.List(i, 3)
TextBoxqua.Text = ListBox1.List(i, 4)
TextBoxfab.Text = CDate(ListBox1.List(i, 5))
TextBoxfin.Text = CDate(ListBox1.List(i, 6))
ComboBoxzon.Text = ListBox1.List(i, 7)
TextBoxall.Text = ListBox1.List(i, 8)
TextBoxcom.Text = ListBox1.List(i, 9)
End Sub

[loune50]

Merci beaucoup mais j'ai un petit souci je n'arrive pas a utiliser as tu s'il te plait le fichier a télécharger car ca me donne quelque erreur

Merci beaucoup avez vous les explication pour que je puisse comprendre un peu avec (excusez moi d'abuser)

Merci

[Daniel.C]

Je viens de rajouter la mise à jour du numéro de ligne dans le ListBox, sinon, après la première suppression, il pouvait y avoir un décalage.

[loune50]

Bonjour,

Un grand merci a Daniel pour le travail qu'il m'a redonné, je n'ai plus qu'a tout comprendre mais merci beaucoup c'est vraiment génial j'ai encore deux trois choses a voir mais je les posterais sur un autre fil car je considère celui ci résolu.

J'ai par contre certaines erreurs qui doivent provenir de mon code que j'avais mis en place avant l'intervention de Daniel et je vais changer certaine chose qui du coup me paraissent inutile .

Merci encore