Classe à l'instar d'un objet range

**Valtrase** · 27/11/2016, 10h48

Bonjour à tous,
Je voudrais changer la gestion des paramètres de ma base de donnée, actuellement j'ai créé une table paramètres et je vais chercher au grès de mes besoins un paramètre bien déterminè (Merci au passage à Hervé Inisan et son grenier).
Pour ce faire je voudrai créer un classe qui se gérerais à l'instar des Objects Range d'Excel de la façon suivante:

Code :

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

1
2
3
 
Myparamètres("Cle du paramètre").Value = True
Myparamètres("Cle du paramètre").Text = "Texte du paramètre"

J'ai testé avec une collection mais je n'arrive pas à reproduire ceci, je suis plutôt dans ce cas là

Code :

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

1
2
 
Myparamètres.value("Clé du Paramètre") = True

Merci pour vos idéees.

Invité · 27/11/2016, 18h04

Bonjour,
En soit, l'objet parameter, est déjà une collection!

Et comme toutes collection il faut une instruction add ou append!

Command.append champ,type,valeur

Si tu veux jouer avec une collection, je te suggèrerais un dictionnary!

Dans ma classe ' je défini une structure public pour les types.

Code :

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

1
2
3
4
5
6
7
8
9
10
Enum ConstAdo    adSmallInt = 2
     adInteger = 3
     adSingle = 4
     adDate = 7
    adstring = 8
     adBoolean = 11
     adDecimal = 14
     adNumeric = 131
     adVarChar = 200
End Enum

Ensuite il faut déclarer un type pour un modèle de paramètre

Code :

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

1
2
3
4
5
type AdoParam
Name as string
TyPatam as ConstAdo
Value as string
End type

Ensuite tu peux soit déclarer un tableau soit faire un collection.

Avec un tableau.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 dim Tparam(2) as adInteger
Tparam(0).name="toto"
Tparam(0).TyPatam=adInteger
Tparam(0).value = 1
 
Tparam(1).name="titi"
Tparam(1).TyPatam=adInteger
Tparam(1).value = 2
 
Tparam(2).name="toto"
Tparam(2).TyPatam=adInteger
Tparam(2).value = 3

Et maintenant on utilise la méthode append

Code :

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

1
2
3
4
5
 
 
For i=0 to ubound(Tparam)
Command.Parameters.Append Tparam(i).name,Tparam(i).TyPatam,Tparam(i).value
Next

Code Module Standard :

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
 
Enum ConstAdo
    adSmallInt = 2
     adInteger = 3
     adSingle = 4
     adDate = 7
     adstring = 8
     adBoolean = 11
     adDecimal = 14
     adNumeric = 131
     adVarChar = 200
End Enum
Type AdoParam
Name As String
TyParam As ConstAdo
Value As String
End Type
Sub test()
Dim typ(1) As AdoParam
Dim con As New ADODBRD
con.TYPEBASE = ACCESS2012
con.BASE = "c:\rep\baseDeDonne.accdb"
con.OpenConnetion
Sql = "select * From MyTable where champ1=? and champ2=?"
typ(0).Name = "champ1": typ(0).TyParam = adInteger: typ(0).Value = 10
typ(1).Name = "champ2": typ(1).TyParam = adstring: typ(1).Value = "toto"
Set Rs = con.OpenCommand(Sql, typ)
End Sub

Code classe ADODBRD :

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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
 
Private Connexion
Public TYPEBASE As MyAdo
Public BASE
Public Server
Public Fichier
Public User
Public PassWord
Enum MyAdo
 ACCESS97 = 1
ACCESS2000 = 2
ACCESS2012 = 1
ODBC = 4
ORACLE = 5
 SQLSERVER2005 = 6
SQLServer2008R2 = 7
SQLite = 8
SQLite3 = 9
CSV = 10
ExcelSensTire = 11
ExcelAvecTire
End Enum
 
 
Private Function GenereCSTRING()
'Permet de générer le Cornec String
'1 - ACCESS 97
'2 - ACCESS 2000
'3 - ACCESS 2012
'4 - ODBC
'5 - ORACLE
'6 - SQL SERVER 2005
'7 - SQL Server 2008 R2
'8 - SQLite
'9 - SQLite3
If Trim("" & Fichier) = "" Then Fichier = BASE
 
 
Select Case TYPEBASE
    Case ExcelAvecTire
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    Case ExcelSensTire
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=no;"""
    Case ACCESS97
        GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & Fichier
    Case ACCESS2000
        GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Persist Security Info=False"
    Case ACCESS2012
        GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"
 
    Case ODBC
        GenereCSTRING = "Provider=MSDASQL.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE
    Case ORACLE
        GenereCSTRING = "Provider=OraOLEDB.Oracle.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE
    Case SQLSERVER2005
        GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & BASE & ";Data Source=" & Server
    Case SQLServer2008R2
        GenereCSTRING = "Provider=SQLNCLI;Server=" & Server & ";Database=" & BASE & ";UID=" & User & ";PWD=" & PassWord & ";"
    Case SQLite
        GenereCSTRING = "Provider=OleSQLite.SQLiteSource.3; Data Source=" & Fichier
        GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & Fichier & ";StepAPI=;Timeout="
    Case SQLite3
        GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & Fichier & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
    Case CSV
        GenereCSTRING = "ODBC;DBQ=" & Fichier & ";Driver={Microsoft Text Driver (*.txt; *.csv)}; " & "DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferS"
    Connex.Open
    Case Else
        GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
 
 
 
 
End Select
''MsgBox GenereCSTRING
'Response.End
End Function
 
 
 
 
Public Function OpenConnetion()
'Ouvre une connexion à  la base de données.
'Dim Fso As New Scripting.FileSystemObject
    OpenConnetion = False
    On Error Resume Next
    Dim ConnecString
 
 
     Dim NbErr
 
 
    Set Connexion = CreateObject("ADODB.Connection")
    Connexion.Open GenereCSTRING
'ConnecString
 
 
    If Err = 0 Then
 
 
        OpenConnetion = True
       Connexion.CommandTimeout = 14400
    Else
'  MsgBox Err.Description
 
 
    End If
'    Debug.Print Err.Description
    Err.Clear
    On Error GoTo 0
End Function
 
 
 
 
Public Function CloseConnection()
'Referme la connexion
CloseConnection = False
On Error Resume Next
    Connexion.Close
    Set Connexion = Nothing
     If Err = 0 Then
        CloseConnection = True
    End If
    Err.Clear
    On Error GoTo 0
End Function
 
 
 
 
Public Function OpenRecordSet(Sql)
'Retourne un RecordeSet
On Error Resume Next
    Dim Rs
Dim NbErr
 
 
Err.Clear
If Connexion.State = 0 Then
    OpenConnetion
End If
'Debug.Print Sql 'Replace(Sql, "%", "*")
    Set OpenRecordSet = CreateObject("ADODB.Recordset")
 
 
   ' OpenRecordSet.LockType = adLockOptimistic
    ''MsgBox  adLockOptimistic & vbcrlf & Err.Description
    OpenRecordSet.Open Sql, Connexion, 1, 3
 
 
    If Err Then
'   MsgBox Err.Description
 
 
    NbErr = NbErr + 1
        If NbErr < 11 Then
 
 
            Set OpenRecordSet = Nothing
 
 
 
 
        End If
 
 
    End If
    Err.Clear
 
 
End Function
Public Function RetournConnection()
Set RetournConnection = Connexion
End Function
Public Function OpenCommand(Sql As String, TableauParam As Variant) As Object
ps.Value = 10
Set cm = CreateObject("ADODB.Command")
Set cm.ActiveConnection = Connexion
For i = 0 To UBound(TableauParam)
Set Param = CreateObject("ADODB.Parameter")
Param.Name = TableauParam(i).Name
Param.Type = TableauParam(i).TyParam
cm.Parameters.Append Param
Set Param = Nothing
Next
Set OpenCommand = cm.Execute
End Function
 
 
Public Function CloseRecordSet(Rs)
On Error Resume Next
    Rs.Close
    Set CloseRecordSet = Nothing
End Function
Public Function Execute(Sql)
    Execute = False
    On Error Resume Next
    Dim NbErr
Reprise:
If Connexion.State = 0 Then
    OpenConnetion
End If
Debug.Print Sql
    Connexion.Execute Sql
    If Err = 0 Then
        Execute = True
 
 
 
 
 
 
 
 
'     Else
'    'MsgBox Err.Description
'         Err.Clear
'    NbErr = NbErr + 1
'    If NbErr < 11 Then
'
'        GoTo Reprise
'    End If
Else
    MsgBox Err.Description
    End If
 
 
    Err.Clear
 
 
End Function

**Jean-Philippe André** · 28/11/2016, 11h57

Salut,

une autre solution pour gerer ta table de parametres :
http://jpcheck.developpez.com/tutori...es-initiation/

Pas de chargement dans une collection, des appels de fonctions.

Invité · 28/11/2016, 19h52

Bonjour Jean-Philippe ,
Je te trouves bien indulgent avec moi, quand je regarde ta réponse je me trouve bien loin du centre de la cible!

une autre solution pour gerer ta table de parametres :

**Jean-Philippe André** · 29/11/2016, 10h20

Hello,

je suis un poil moins élaboré dans mon raisonnement on dira

**Valtrase** · 11/12/2016, 10h00

Bonjour,

Tout d’abord désolé pour cette réponse tardive, mais mon travail me prends de plus en plus de temps...
Jean-Philippe la solution que tu me propose est exactement celle que j'utilise et qui me va pas mal pour le moment. Jutilise une table paramètres:

NumAuto, Name, Value, Id, Remarque, IdParent, Sort.

Name, Value et Remarque me servent à gérer mes paramètre. Et la totalité me servent aussi a alimenter un TreeView et je suis content de tout cela. ce qui me gène un peu ce sont tous ces accès avec des Get et SetParam un peu partout dans mon programme.
A terme je voudrais aussi la transposer Sous VB.Net, bien entendu il y a une gestion de paramètres sous Studio 2016 mais elle ne me conviens pas.
Dysorthographie je vais regarder tout ça de plus près mais a première vue je ne pense pas que cela soit ce que je recherche. mais tu m'as donné une idée pour améliorer ce qui est existant; Et c'est déjà pas mal en soit.

Dans tous les cas merci de vos réponses.

Classe à l'instar d'un objet range

VBA Access

Discussions similaires

Partager

Partager