Erreur sur modification de données avec un formulaire

**counterbob** · 22/04/2017, 19h53

Bonjour
Sur un formulaire qui permet l'ajout , la modification et la suppression de données (ligne)
l'ajout se fait bien en dernière ligne mais la modification et la suppression se fait sur la première ligne au lieu de la ligne sélectionnée dans une listbox.

je pense que me.enreg ne prend pas la bonne valeur mais je ne trouve pas la solution.

Cette question est peut-être pour boisgontierjacques
merci pour votre aide

Ouverture Userform

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
Private Sub UserForm_Initialize()
   Set f = Sheets("BD")
   Set Rng = f.Range("A2:m" & f.[A65000].End(xlUp).Row)
  BD = f.Range("A2:N" & f.[A65000].End(xlUp).Row).Value
  'BD = f.Range("A2:M" & f.[A65000].End(xlUp).Row).Value
 ' BD = Rng.Value
    Ncol = Rng.Columns.Count
  Set d = CreateObject("Scripting.Dictionary")
 
 
 
  Tri BD, LBound(BD), UBound(BD), 2 ' version tri col ville
 d("*") = ""
 For i = LBound(BD) To UBound(BD)
    d(BD(i, 2)) = ""
  Next i
 Me.ComboBox2.List = d.keys
  Me.ComboBox2 = "*"
  d.RemoveAll
 
 
  Tri BD, LBound(BD), UBound(BD), 3  ' version tri cerem
  d("*") = ""
  For i = LBound(BD) To UBound(BD)
    d(BD(i, 3)) = ""
  Next i
  Me.ComboBox3.List = d.keys:
  Me.ComboBox3 = "*"
  d.RemoveAll
 
 
  Tri BD, LBound(BD), UBound(BD), 4  ' version tri date
  d("*") = ""
  For i = LBound(BD) To UBound(BD)
     d(Year(BD(i, 4))) = ""
  Next i
  Me.ComboBox1.List = d.keys:
  Me.ComboBox1 = "*"
  'd.RemoveAll
 
 
 
  Me.ListBox1.ColumnCount = 14
  Me.ListBox1.ColumnWidths = "50;60;150;50;30;30;50;50;50;50;50;50;50;50;1"
  Me.ListBox1.List = BD
 
 
    Me.Enreg = f.[A65000].End(xlUp).Row + 1
 
 
 
 
End Sub

Sélection Listbox

Code :

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

1
2
3
4
5
6
7
Private Sub ListBox1_Click()
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
   Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1
 
End Sub

Bouton ajout/modif

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
Private Sub b_modif_Click()
Me.TextBox11 = Year(Now)
 
 
    If Me.Enreg <> "" And Me.textbox1 <> "" Then
      NoEnreg = Me.Enreg
      For K = 1 To Ncol
        X = Replace(Me("textBox" & K), " ", "")
         If IsNumeric(X) Then
           f.Cells(NoEnreg, K) = Val(X)
         Else
           f.Cells(NoEnreg, K) = Me("textBox" & K)
         End If
      Next K
      raz
      Me.Enreg = ""
 
      'Me.textbox1.Paste
      Unload F_dates
      Unload F_calendrier2datesForm
      F_dates.Hide
      F_calendrier2datesForm.Hide
 
      UserForm_Initialize
    End If
 
End Sub
Private Sub b_ajout_Click()
  raz
  Me.Enreg = f.[A65000].End(xlUp).Row + 1
 
End Sub
Private Sub B_sup_Click()
 If MsgBox("Etes vous sûr de suppimer la demande de :  " & f.Cells(Enreg, 2) & " du " & f.Cells(Enreg, 4) & " ?", vbYesNo) = vbYes Then
   Enreg = Me.Enreg
   f.Cells(Enreg, 1).Resize(, Ncol).Delete Shift:=xlUp
   raz
   Me.Enreg = ""
   UserForm_Initialize
 End If
End Sub

Bouton Supprimer

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub B_sup_Click()
 If MsgBox("Etes vous sûr de suppimer la demande de :  " & f.Cells(Enreg, 2) & " du " & f.Cells(Enreg, 4) & " ?", vbYesNo) = vbYes Then
   Enreg = Me.Enreg
   f.Cells(Enreg, 1).Resize(, Ncol).Delete Shift:=xlUp
   raz
   Me.Enreg = ""
   UserForm_Initialize
 End If
End Sub

**unparia** · 23/04/2017, 06h22

Bonjour
où as-tu déclaré la variable rng ? (ton code ne le montre pas)

**counterbob** · 23/04/2017, 11h37

Envoyé par unparia

Bonjour
où as-tu déclaré la variable rng ? (ton code ne le montre pas)

bonjour
à l'initialisation userform

**counterbob** · 23/04/2017, 18h41

il n'y plus cette erreur mais maintenant
c'est sur ce code lors de la sélection d'une ligne de la listbox1

Code :

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

1
2
3
4
5
Private Sub ListBox1_Click()
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
 Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1

erreur Impossible de lire la propriété Column. Argument non valide.

**Nicolas JACQUIN** · 23/04/2017, 18h46

Bonjour,
tu dis que tu l'a déclaré à l'ouverture de ta form, déclare là en tête de projet

**counterbob** · 24/04/2017, 19h35

bonjour
je désespère

les combobox 2 et 3 ne contiennent que deux valeurs

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
Private Sub UserForm_Initialize()
 
   Set f = Sheets("bd")
   Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
   BD = Rng.Value
   Ncol = Rng.Columns.Count
  Set d1 = CreateObject("Scripting.Dictionary")
   Set d2 = CreateObject("Scripting.Dictionary")
   Set d3 = CreateObject("Scripting.Dictionary")
   d1.CompareMode = vbTextCompare
   d2.CompareMode = vbTextCompare
   d3.CompareMode = vbTextCompare
   For i = LBound(BD) To UBound(BD)
    If Not d1.exists(BD(i, 12)) Then
        d1(BD(i, 12)) = ""
 
    If Not d2.exists(BD(i, 2)) Then
            d2(BD(i, 2)) = ""
 
            If Not d3.exists(BD(i, 3)) Then
                d3(BD(i, 3)) = ""
            End If
        End If
    End If
   Next i
 
   '--avec tri
    temp = d1.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox1.List = temp
 
   temp = d2.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox2.List = temp
 
   temp = d3.keys
   Call Tri(temp, LBound(temp), UBound(temp))
   Me.ComboBox3.List = temp
 
  Me.ListBox1.Clear
   Me.ComboBox1.ListIndex = -1
   Me.ComboBox2.ListIndex = -1
 
  'Me.ListBox1.ColumnCount = 14
  Me.ListBox1.ColumnWidths = "50;60;250;60;50;50;100;50;50;50;200;0;0;0"
  Me.ListBox1.List = BD
 
 
 
 
    Me.Enreg = f.[A65000].End(xlUp).Row + 1
 
   Me.ComboBox5.ColumnCount = 2
   Me.ComboBox5.ColumnWidths = "350,40"
   Me.ComboBox5.RowSource = "ceremonie"
   Me.ComboBox1.ListIndex = 2
   Me.ComboBox2 = "*"
 
   F_calendrier2datesForm.Hide
End Sub
Private Sub ComboBox1_click()
  Me.ListBox1.Clear
  For K = 1 To Ncol: Me("textBox" & K) = ""
  Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 12), Me.ComboBox1)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox1 = BD(i, 12) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
 
      Next K
      b(j, K) = i
    End If
   Next i
   ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub
 
Private Sub ComboBox2_click()
'affiche
 
  Me.ListBox1.Clear
  For K = 1 To Ncol: Me("textBox" & K) = "": Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 2), Me.ComboBox2)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox2 = BD(i, 2) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
 
      Next K
      b(j, K) = i
    End If
   Next i
  ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub
 
Private Sub ComboBox3_click()
  Me.ListBox1.Clear
  For K = 1 To Ncol: Me("textBox" & K) = "": Next K
  j = 0
  n = Application.CountIf(Application.Index(Rng, , 3), Me.ComboBox3)
  Dim b()
  ReDim b(1 To n, 1 To Ncol + 1)
  For i = LBound(BD) To UBound(BD)
    If Me.ComboBox3 = BD(i, 3) Then
      j = j + 1
      For K = 1 To Ncol
        b(j, K) = BD(i, K)
 
      Next K
      b(j, K) = i
    End If
   Next i
   ListBox1.List = b
   ListBox1.ListIndex = 0
End Sub
Private Sub ListBox1_Click()
Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
    For K = 1 To Ncol
      Me("textBox" & K) = Me.ListBox1.Column(K - 1)
    Next K
   Me.Enreg = Me.ListBox1.Column(Ncol) + Rng.Row - 1
 
End Sub
 
Sub Tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
        temp = a(g): a(g) = a(d): a(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Erreur sur modification de données avec un formulaire

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager