Discussion :

[Mandragore99]

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!

[Invité]

Bonsoir,
j'imagine que A<> 0 c'est la colonne [A] mais les colonnes dans Sql sont soit la valeur lue sur la première ligne de ta plage si HDR=true imaginons que [A1]= Valeur mensuel
where [Valeur mensuel]<>0

si HDR=false F1,F2,FX etc... (F pour Field)
where [F1l]<>0

Code :

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

1
2
3
4
5
6
7
8
 
With Createobject("ADODB.Connection")
   .open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\Ouvertures_de_comptes.xls;Extended Properties=""Excel 12.0;HDR=YES;"""
    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"  
 
Me.ListBox1.List = application.transpose(.Execute("SELECT *  FROM [BD$A1:AI5000] where A<> 0").GetRows)
 .close
 End With

[Mandragore99]

Merci pour votre réponse!

Effectivement j'ai remplacé le nom des premières lignes de chaque colonnes par des lettres, mais elles sont bien nommées dans la BDD. j'ai réduit le nombre de colones pour simplifier l'exemple:

Titre en A1 : NumeroLigne (format nombre)
Titre en B1 : ValeurMensuel (format variant)
Titre en C1 : DateDebut (format date (dd/mm/yy hh:mm)
Titre en D1 : RefDossier (format variant)
Titre en E1 : DateFin (format date dd/mm/yyyy)
Titre en F1: Scan (format bolean)
Titre en G1: Remarque (format string)

----

J'ai donc remplacé le code comme suit:

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
 
Private Sub UserForm_Initialize()
  'Microsoft ActiveX DataObject doit être coché
  ' Champ nommé BD
  Set cnn = New ADODB.Connection
 
  With CreateObject("ADODB.Connection")
   .Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\OuvCpte.xls;Extended Properties=""Excel 12.0;HDR=yes;"""
    Me.ListBox1.ColumnWidths = "50;50;50;50;50;50;50"
 
Me.ListBox1.List = Application.Transpose(.Execute("SELECT *  FROM [BD$A1:G5] where NumeroLigne<> 0").GetRows)
 
 .Close
 End With
 
 
  End Sub

# Problème1:
Le formulaire ne fait apparaitre que les 4 premieres colones, comme dans le code initial.

Example en image:



#Problème2:
La recherche intuitive ne fonctionne plus avec ce code, erreur à la ligne suivante :

Code :

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

For i = LBound(Liste) To UBound(Liste)

"liste" n'existe plus et il m'est impossible d'ajouter le code suivant:

Code :

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

Me.ListBox1.liste = Liste

car cela renvoie une erreur "Run time 380 : could not set the list property. invalid property value"

Puis-je vous demander votre aide à nouveau s'il vous plait ?

[Invité]

Bonjour,
regarde comme ça!

Code :

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

1
2
3
4
5
6
7
With Createobject("ADODB.Connection")
   .open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\Ouvertures_de_comptes.xls;Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"""
    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"  
 
Me.ListBox1.List = application.transpose(.Execute("SELECT [NumeroLigne],[ValeurMensuel],format([DateDebut],'dd/mm/yy hh:mm'),[RefDossier],format([DateFin],'dd/mm/yyyy'),[Scan],[Remarque]  FROM [BD$A1:AI5000] where [NumeroLigne]<> 0").GetRows)
 .close
 End With

Code :

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

For i 0 To Me.ListBox1.liste .count-1

[Mandragore99]

Bonjour,

J'ai donc copié le code suivant:

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 UserForm_Initialize()
  'Microsoft ActiveX DataObject doit être coché
  ' Champ nommé BD
  Set cnn = New ADODB.Connection
 
With CreateObject("ADODB.Connection")
   .Open = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.path & "\OuvCpte.xls;Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"""
    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"
 
Me.ListBox1.List = Application.Transpose(.Execute("SELECT [NumeroLigne],[ValeurMensuel],format([DateDebut],'dd/mm/yy hh:mm'),[RefDossier],format([DateFin],'dd/mm/yyyy'),[Scan],[Remarque]  FROM [BD$A1:AI5000] where [NumeroLigne]<> 0").GetRows)
 .Close
 End With
 
  End Sub

Il n'y a toujours que 4 colonnes repertoriées dans la listbox. Pire, j'ai copié ce code dans un nouveau classeur excel et là il n'y a que la première colonne qui apparait...
manquerait-il une référence à activer, une configuration à faire dans le formulaire ?
J'ai actuellement:
VBA
Microsoft excel 12.0 Object library
OLE AUTOMATION
Microsoft office 12.0 Object library
Microsoft Forms 2.0 Object library
Microsoft winsows Common controls 6.0
Microsoft internet Controls
Microsoft Outlook 12.0 Object library
Microsoft Word 12.0
Microsoft ActiveX Data Object 6.1 library
Microsoft OLE DB provider for OLAP
Microsofr OLE DB service component
Microsofr OLE DB simple provider 1.5 library

--------------------

Concernant le deuxième bout de code, VBA me renvoie une erreur et et je n'ai pas compris où tu voulais que je le place:

Code :

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

For i 0 To Me.ListBox1.liste .count-1

je suppose que tu voulais dire :

Code :

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

For i = 0 To Me.ListBox1.list .count-1

Merci d'avance pour ton aide dysorthographie et à toute parsonne qui pourrait m'aider à résoudre ce problème.

[Mandragore99]

Bonjour,

je viens de trouver la cause du souci:

Dans la propriété de la listbox, la fonction ColumnCount était à 4... Il suffisait de le passer au nombre désiré, 32 en l'occurence pour mon cas.

merci pour votre aide.

Mandra