Discussion :

[anissa5]

bonjour tout le monde j'ai un grand souci sa va faire une semaine que je galère et j' ai besoin de votre aide svp avec le code vba des boutons supprimer et ajouter dans userform voila mon problème dans ma feuil excel 'BDA' le début d’enregistrement des lignes commence de (A3:F).
Quant la ligne (A3:F) et vide et je lance Userform puis je clic sur B_nouveau il me renvois cette erreur ' erreur d'execution '13' Incompatible de type' elle s'arrêt sur la ligne suivante

Code :

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

Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1

dans

Code :

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

1
2
3
4
5
6
7
8
9
 
Private Sub B_nouveau_Click()
razChampForm
TextBox15 = Date
LigneEnreg = f.[A65000].End(xlUp).Row + 1
  Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1
  Me.LigneEnregC = LigneEnreg
  Me.TextBox14.SetFocus
End Sub

mais si je remplir la première ligne (A3:F) et juste A3= N° ET B3= DATE Manuellement au lancement de nouveau le userform le bouton nouveau fonction et sans erreurs

pour le bouton supprimer quand y a plusieurs lignes remplis dans la feuil 'BDA'(A3:F) il s'execute normale il sufit juste de sélectionner une ligne dans la lisbox dans userform et de clic sur supprimer mais quand j'arrive a la premier ligne (A3:F3) et la dernier a supperimer de la feuil 'BDA' il me renvois cette erreur ' erreur d'execution '13' Incompatible de type' elle s'arrêt sur la ligne suivante

Code :

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

If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date

dans

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
Private Sub ComboBox1_Change()
   Set d1 = CreateObject("scripting.dictionary")
     Set d2 = CreateObject("scripting.dictionary")
     razChampForm
     clé1 = UCase(Me.ComboBox1) & "*": clé2 = Me.ComboBox2 & "*"
 
     Dim b()
     n = 0: ncol = UBound(bv, 2)
     For i = LBound(bv) To UBound(bv)
                   'nom                         'date
       If UCase(bv(i, 3)) Like clé1 And UCase(bv(i, 2)) Like clé2 Then
 
         If bv(i, 3) <> "" Then d1(bv(i, 3)) = bv(i, 3)
         n = n + 1
         ReDim Preserve b(1 To ncol, 1 To n)
         For K = 1 To ncol: b(K, n) = bv(i, K): Next
       End If
 
       'If UCase(bv(i, 3)) Like clé2 And UCase(bv(i, 2)) Like clé1 Then If bv(i, 2) <> "" Then d1(bv(i, 2)) = bv(i, 2)
       If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date
      Next i
 
      If n > 0 Then
        ReDim Preserve b(1 To ncol, 1 To n + 1)
        Me.ListBox1.List = Application.Transpose(b)
        Me.ListBox1.RemoveItem n
        Cbx1 = d1.Keys
        Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
        Me.ComboBox1.List = Cbx1
        If ActiveControl.Name = "ComboBox1" Then Me.ComboBox1.DropDown
        Cbx2 = d2.items
        Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
        Me.ComboBox2.List = Cbx2
      End If
 
End Sub

a ce stade quand je relance le user forme je perds tout le remplissages des label dans mon userform voila le reste de mon code et mon fichier en pièce jointe merci a vous tous du fond de mon cœur bonne et excellente nuit

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
Private Sub B_valider_Click()
If Me.LigneEnregC <> 0 And Me.TextBox14 <> "" And LigneEnreg <> 0 Then
   lig = LigneEnreg
   For Each K In Array(1, 2, 5)
     tmp = Me("textbox" & K + 13)
     If IsNumeric(tmp) Then
        f.Cells(lig, K) = CDbl(tmp)
     Else
        If IsDate(f.Cells(lig, K)) Then
           f.Cells(lig, K) = CDate(tmp)
        Else
           f.Cells(lig, K) = tmp
        End If
     End If
   Next
   f.Cells(lig, 2) = CDate(TextBox15.Value)
   f.Cells(lig, 3) = Me.ComboBox3 'employe
   If OptionButton1 = True Then
   f.Cells(lig, 4) = "Puce1"  'unit
   End If
 If OptionButton2 = True Then
   f.Cells(lig, 4) = "Puce2"  'unit
 End If
 
 
   'f.Cells(lig, 6) = Me.ComboVille 'produit
   'f.Cells(lig, 14) = Me.TextBox27 'unit
 
   'f.Cells(lig, 5) = Me.Combocf 'client f
   'f.Cells(lig, 2) = Me.Comboaction 'action
 
   Ligne = ListBox1.ListIndex
   bv = f.Range("A3:f" & [A65000].End(xlUp).Row).Value
   ComboBox1_Change
   Me.ListBox1.ListIndex = Ligne
 razChampForm
 End If
End Sub
 
 
 
 
 
Private Sub ListBox1_Click()
  Ligne = ListBox1.ListIndex
  For Each i In Array(1, 2, 4, 5)
      Me("textbox" & i + 13) = ListBox1.List(Ligne, i - 1)
  Next i
  Me.ggg = ListBox1.List(Ligne, 2) 'categorie
 
  reservation = Me.TextBox14
  Set result = f.[A:A].Find(what:=reservation)
  If Not result Is Nothing Then
    LigneEnreg = result.Row
    Me.LigneEnregC = LigneEnreg
  Else
    MsgBox "Erreur no réservation"
  End If
End Sub
Private Sub ComboBox2_Change()
  ComboBox1_Change
End Sub
 
Private Sub UserForm_Initialize()
 
   TextBox15 = Date
  Sheets("BDA").Activate
  Feuil1.Visible = xlSheetVisible
 
  Set f = Sheets("BDA")
  If f.[B3] = "" Then Exit Sub
  bv = f.Range("a3:f" & [A65000].End(xlUp).Row).Value
 Me.ComboBox3.List = Array("Tom", "Mani", "Ramv")
 
 
  For i = 1 To UBound(bv, 2) - 1
   temp = temp & f.Columns(i).Width * 0.62 & ";"
   Me("label" & i) = f.Cells(2, i)
   Me("label" & i + 19) = f.Cells(2, i)
   Me("label" & i).Top = Me.ListBox1.Top - 15
   Largeur = Largeur + f.Columns(i).Width * 1
  Next
  Me.ListBox1.ColumnWidths = temp: Me.Width = Largeur - 128
 
  Me.ListBox1.List = bv
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bv)
    If bv(i, 3) <> "" Then d1(bv(i, 3)) = ""
  Next i
  Cbx1 = d1.Keys
  Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.SetFocus
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bv)
    If bv(i, 2) <> "" Then d1(bv(i, 2)) = CDate(bv(i, 2))
  Next i
  Cbx2 = d1.items
  Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
  Me.ComboBox2.List = Cbx2
 End Sub
 
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.DropDown
End Sub
 
 
Sub razChampForm()
 For Each K In Array(1, 2, 4, 5)
    Me("textbox" & K + 13) = ""
 Next
 
 Me.ggg = ""
End Sub
 
Sub tri(a, gauc, droi) ' Quick sort
 
End Sub
Private Sub B_suppression_Click()
If MsgBox("Etes vous sûr?", vbYesNo) = vbYes Then
  If LigneEnreg <> 0 Then
    Rows(LigneEnreg).Delete
    bv = f.Range("a3:f" & [A65000].End(xlUp).Row).Value
    ComboBox1_Change
 
  razChampForm
  End If
 End If
End Sub