Bonjour à toutes et tous!

Je dispose d'une Base de données contenant des informations de format varié : (reférence unique/ texte / dates / nombres) afin d'effectuer un suivi de dossier.

j'ai développé une feuille de création de nouveau dossier me permettant d'intégrer une nouvelle ligne à ces tableaux. le formulaire est dans un classeur excel, la base de donnée est dans un autre classeur.

J'utilise une connexion ADODB pour ajouter de nouvelles entrée et tout fonctionne parfaitement bien.

Mon Objectif:

#1 Alimenter une listbox de la base de donnée fermée,
#2 effectuer une recherche intuitive dans une textbox afin de retrouver le dossier désiré
#3 Refléter le contenu de la ligne selectionnée de la listbox dans la feuille du classeur contenant la macro.


Etat d'avancement:

J'ai adapté le code suivant qui ne fonctionne que partiellement:

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
 
 
Dim Liste()
Private Sub UserForm_Initialize()
  'Microsoft ActiveX DataObject doit être coché
  ' Champ nommé BD
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & _
      ThisWorkbook.path & "\" & "Ouvertures_de_comptes.xls"
  Set rs = cnn.Execute("SELECT count(*) as nb FROM [BD$A1:AI5000] where A<>0")
  ReDim Liste(0 To rs("nb"), 1 To 35)
  'Set rs = cnn.Execute("SELECT libellé,Codification,Prix,Unité FROM BD where libellé<>''")
  Set rs = cnn.Execute("SELECT A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,BB,CC,DD,EE,FF,GG,HH,II FROM [BD$A1:AI5000] where A<> 0")
  Me.ListBox1.Clear
  i = 0
  Do While Not rs.EOF
 
    On Error Resume Next   ' cellules vides
    Liste(i, 1) = rs("A")
    Liste(i, 2) = rs("B")
    Liste(i, 3) = rs("C")
    Liste(i, 4) = rs("D")
    Liste(i, 5) = rs("E")
    Liste(i, 6) = rs("F")
    Liste(i, 7) = rs("G")
    Liste(i, 8) = rs("H")
    Liste(i, 9) = rs("I")
    Liste(i, 10) = rs("J")
    Liste(i, 11) = rs("K")
    Liste(i, 12) = rs("L")
    Liste(i, 13) = rs("M")
    Liste(i, 14) = rs("N")
    Liste(i, 15) = rs("O")
    Liste(i, 16) = rs("P")
    Liste(i, 17) = rs("Q")
    Liste(i, 18) = rs("R")
    Liste(i, 19) = rs("S")
    Liste(i, 20) = rs("T")
    Liste(i, 21) = rs("U")
    Liste(i, 22) = rs("V")
    Liste(i, 23) = rs("W")
    Liste(i, 24) = rs("X")
    Liste(i, 25) = rs("Y")
    Liste(i, 26) = rs("Z")
    Liste(i, 27) = rs("AA")
    Liste(i, 28) = rs("BB")
    Liste(i, 29) = rs("CC")
    Liste(i, 30) = rs("DD")
    Liste(i, 31) = rs("EE")
    Liste(i, 32) = rs("FF")
    Liste(i, 33) = rs("GG")
    Liste(i, 34) = rs("HH")
    Liste(i, 35) = rs("II")
 
 
    On Error GoTo 0
    i = i + 1
    rs.MoveNext
  Loop
 
 
  With Me.ListBox1
 
    .ColumnWidths = "30;90;90;30;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60"
    .List = Liste
  End With
 
 
 
 
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  Liste = Me.ListBox1.List
End Sub
Private Sub TextBox1_Change()
   Me.ListBox1.Clear
   j = 0
   For i = LBound(Liste) To UBound(Liste)
     If UCase(Liste(i, 0)) Like "*" & UCase(Me.TextBox1) & "*" _
        Or "*" & UCase(Liste(i, 1)) Like "*" & UCase(Me.TextBox1) & "*" Then
        On Error Resume Next
 
 
        Me.ListBox1.AddItem Liste(i, 0)
        Me.ListBox1.List(j, 1) = Liste(i, 1)
        Me.ListBox1.List(j, 2) = Liste(i, 2)
        Me.ListBox1.List(j, 3) = Liste(i, 3)
        Me.ListBox1.List(j, 4) = Liste(i, 4)
        Me.ListBox1.List(j, 5) = Liste(i, 5)
        Me.ListBox1.List(j, 6) = Liste(i, 6)
        Me.ListBox1.List(j, 7) = Liste(i, 7)
        Me.ListBox1.List(j, 8) = Liste(i, 8)
        Me.ListBox1.List(j, 9) = Liste(i, 9)
        Me.ListBox1.List(j, 10) = Liste(i, 10)
        Me.ListBox1.List(j, 11) = Liste(i, 11)
        Me.ListBox1.List(j, 12) = Liste(i, 12)
        Me.ListBox1.List(j, 13) = Liste(i, 13)
        Me.ListBox1.List(j, 14) = Liste(i, 14)
        Me.ListBox1.List(j, 15) = Liste(i, 15)
        Me.ListBox1.List(j, 16) = Liste(i, 16)
       Me.ListBox1.List(j, 17) = Liste(i, 17)
        Me.ListBox1.List(j, 18) = Liste(i, 18)
        Me.ListBox1.List(j, 19) = Liste(i, 19)
       Me.ListBox1.List(j, 20) = Liste(i, 20)
        Me.ListBox1.List(j, 21) = Liste(i, 21)
        Me.ListBox1.List(j, 22) = Liste(i, 22)
        Me.ListBox1.List(j, 23) = Liste(i, 23)
        Me.ListBox1.List(j, 24) = Liste(i, 24)
        Me.ListBox1.List(j, 25) = Liste(i, 25)
        Me.ListBox1.List(j, 26) = Liste(i, 26)
        Me.ListBox1.List(j, 27) = Liste(i, 27)
        Me.ListBox1.List(j, 28) = Liste(i, 28)
        Me.ListBox1.List(j, 29) = Liste(i, 29)
        Me.ListBox1.List(j, 30) = Liste(i, 30)
        Me.ListBox1.List(j, 31) = Liste(i, 31)
        Me.ListBox1.List(j, 32) = Liste(i, 32)
        Me.ListBox1.List(j, 33) = Liste(i, 33)
        Me.ListBox1.List(j, 34) = Liste(i, 34)
 
 
        On Error GoTo 0
        j = j + 1
     End If
   Next i
End Sub
 
Private Sub ListBox1_Click()
  ActiveCell = Me.ListBox1
  ActiveCell.Offset(, 1) = Me.ListBox1.Column(1)
  ActiveCell.Offset(, 2) = CDbl(Me.ListBox1.Column(2))
  ActiveCell.Offset(, 3) = Me.ListBox1.Column(3)
 
'etc jusquà refléter toutes les colonnes dans ma feuille
 
  Unload Me
End Sub


Ce code me permet de:
- sélectionner les infos dans le classeur fermé
- apparaitre un textbox de recherche intuitive

En revanche, la listbox ne contient que 4 colonnes et impossible de faire apparaitre les autres ...

J'ai essayé de modifier le contenu des cellules dans le classeur fermé, en vain!

Auriez vous la compétence et l'amabilité de m'indiquer la ligne à modifier?

Merci d'avance!