Discussion :

[grandmulongo]

Bonsoir à tous les membres du forum.
Alors, voilà. J'ai créé un petit fichier Excel avec des formulaires pour la saisie et la modification des données.
Je voudrais arriver à n' autoriser les accès qu'avec un mot de passe multi utilisateurs sur la base d' un tableau
Seulement, lorsque je veux ouvrir le userform5 ou userform6, le message d'un time error'9' s'affiche.
J'ai tenté tout ce que je pouvais, sans succès. Je mets le code du bouton qui appelle le userform8 et le code du userform8.
Quelqu'un peut il m' aider, s'il vous plait?

Code :

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

1
2
3
4
5
 
Sub CommandButton15_Click()
Unload Me
UserForm8.Show
End Sub

Dans le code du bouton, la ligne

Code :

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

1
2
 
Userform8.show

Est surligné en jaune et dans le code de l' userform8, c'est la partie suivante qui bloque

Code :

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

1
2
3
4
5
6
7
8
9
 
Private Sub UserForm_Initialize()
  Set f = Sheets("Personnel")
  Set s = Sheets("Base_Donnees")
  colCle = 1            ' ADAPTER
  nbCol = f.[iv1].End(xlToLeft).Column
  For k = 1 To nbCol
    Me("label" & k).Caption = f.Cells(1, k)
  Next k

'Et le code du userform8

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
Option Compare Text
Dim f, tblClé(), nbCol, ligneEnreg, colCle
 
Private Sub UserForm_Initialize()
  Set f = Sheets("Personnel")
  Set s = Sheets("Base_Donnees")
  colCle = 1            ' ADAPTER
  nbCol = f.[iv1].End(xlToLeft).Column
  For k = 1 To nbCol
    Me("label" & k).Caption = f.Cells(1, k)
  Next k
  For k = nbCol + 1 To 24
    Me("label" & k).Visible = False
    Me("textbox" & k).Visible = False
  Next k
  '--
  n = f.[a65000].End(xlUp).Row - 1
  Set d = CreateObject("scripting.dictionary")
  a = f.Range("a2:a" & f.[a65000].End(xlUp).Row).Offset(, colCle - 1).Value
  For i = 1 To UBound(a)
    If Not d.exists(a(i, 1)) Then d(a(i, 1)) = i + 1
  Next i
  ReDim tblClé(1 To d.Count, 1 To 2)
  i = 0
  For Each c In d.keys
    i = i + 1: tblClé(i, 1) = c: tblClé(i, 2) = d(c)
  Next c
  Call Tri2Col(tblClé, LBound(tblClé), UBound(tblClé))
  Me.ComboBox1.List = tblClé
  Me.ComboBox1.ListIndex = -1
End Sub
Private Sub ComboBox1_Change()
  Set d1 = CreateObject("Scripting.Dictionary")
  tmp = UCase(Me.ComboBox1) & "*"
  For p = LBound(tblClé) To UBound(tblClé)
    If UCase(tblClé(p, 1)) Like tmp Then d1(tblClé(p, 1)) = ""
  Next p
  If d1.Count > 0 Then
    Dim b(): ReDim b(1 To d1.Count, 1 To 2)
    j = 0
    For p = LBound(tblClé) To UBound(tblClé)
      If UCase(tblClé(p, 1)) Like tmp Then
        j = j + 1
        b(j, 1) = tblClé(p, 1): b(j, 2) = tblClé(p, 2)
      End If
    Next p
    Me.ComboBox1.List = b
    Me.ComboBox1.DropDown
  End If
End Sub
Private Sub ComboBox1_Click()
  ligneEnreg = Me.ComboBox1.Column(1)
  For Z = 1 To nbCol
    Me("textbox" & Z) = f.Cells(ligneEnreg, Z)
  Next Z
  listeExistants
End Sub
Sub listeExistants()
  Me.ListBox1.Clear
  i = 0
  a = f.Range("a2:a" & f.[a65000].End(xlUp).Row).Resize(, nbCol)
  tmp = UCase(Me.ComboBox1)
  For k = 1 To UBound(a)
    If UCase(a(k, colCle)) = tmp Then n = n + 1
  Next k
  Dim b(): ReDim b(1 To n, 1 To 4)
  For k = 1 To UBound(a)
    If UCase(a(k, colCle)) = tmp Then
      i = i + 1
      b(i, 1) = a(k, 1)
      b(i, 2) = a(k, 2)
      b(i, 3) = a(k, 3)
      b(i, 4) = k + 1
    End If
  Next k
  Me.ListBox1.List = b
End Sub
Private Sub ListBox1_Click()
  ligneEnreg = Me.ListBox1.Column(3)
  For Z = 1 To nbCol
    Me("textbox" & Z) = f.Cells(ligneEnreg, Z)
      Next Z
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = tblClé
  Me.ComboBox1.ListIndex = -1
  Me.ComboBox1.DropDown
End Sub
 
Private Sub B_modif_Click()
Dim MyDate
MyDate = Date ' MyDate contient the current system date.
        If Me.TextBox1 = "" Or ligneEnreg = 0 Then Me.TextBox1.SetFocus: Exit Sub
     For k = 1 To nbCol
        tmp = Me("TextBox" & k)
        If IsNumeric(tmp) Then tmp = Val(tmp)
        If IsDate(tmp) Then tmp = CDate(tmp)
        f.Cells(ligneEnreg, k) = tmp
 
    Next k
    raz
    ligneEnreg = f.[a65000].End(xlUp).Row + 1
    UserForm_Initialize
    Me.ComboBox1.ListIndex = -1
    Me.ComboBox1.SetFocus
End Sub
Sub Tri2Col(a(), gauc, droi)  ' Quick sort
  ref = a((gauc + droi) \ 2, 1) & a((gauc + droi) \ 2, 2)
  g = gauc: d = droi
  Do
    Do While a(g, 1) & a(g, 2) < ref: g = g + 1: Loop
    Do While ref < a(d, 1) & a(d, 2): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri2Col(a, g, droi)
  If gauc < d Then Call Tri2Col(a, gauc, d)
End Sub
Private Sub B_nouv_Click()
  ligneEnreg = f.[a65000].End(xlUp).Row + 1
  raz
  Me.TextBox1.SetFocus
End Sub
 
Sub raz()
  Dim c As Control
  For Each c In Me.Controls
    Select Case TypeName(c)
      Case "TextBox"
        c.Value = ""
    End Select
  Next c
  Me.ListBox1.Clear
End Sub

[ProgElecT]

Salut, bienvenue sur DVP

subscript out of range ---> indice hors limites
Donc l'erreur doit être à la ligne Me("label" & k).Caption = f.Cells(1, k) en effet For k = 1 To nbCol nbCol devrait être égal à ( f.[iv1].End(xlToLeft).Column)-1 et le For Kdevrait démarrer à 0
Si c'est pas çà, regardes la concordance entre le N° des labels et le N° des colonnes.