Discussion :

[mathspountz]

Bonjour à tous,

Je me remets au vba après un an de pause à faire du js/php, j'avais donc pris la bonne habitude de faire de la POO. Ceci devient pourtant très fastidieux en vba...

Du coup je créé une grosse classe abstraite avec plein de types à l'intérieur et j'ai notamment un array de chaque type que je dois souvent manipuler (ajout, update, suppression, tri, filtre etc...)
J'ai donc créé des fonctions pour manipuler les array facilement malheureusement je n'ai pas trouver comment surcharger une fonction car les types utilisateurs ne peuvent pas être convertis en variant...

Exemple :

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
 
Type tField
    attr1 As String
    attr2 As Date
End Type
Type tTable
    attr1 As String
    attr2 As Date
End Type
 
Sub main()
    Dim arrFields() As tField
    Dim field As tField
    Dim arrTables() As tTable
    Dim table As tTable
 
    field.attr1 = "test"
    field.attr2 = Date
    table.attr1 = "test"
    table.attr2 = Date
 
    arrPush arrFields, field
    arrPush arrTables, table
End Sub
 
Private Sub arrPush(arr, el)
    If isErasedArray(arr) Then
        ReDim arr(1)
    Else
        ReDim Preserve arr(UBound(arr) + 1)
    End If
    arr(UBound(arr)) = el
End Sub
Private Function isErasedArray(arr) As Boolean
    Dim a&
    On Error GoTo ieaError
    a = UBound(arr)
    isErasedArray = False
    Exit Function
ieaError:
isErasedArray = True
End Function

Je me retrouve avec le message d'erreur

"Erreur de compilation: Seuls les types définis par l'utilisateur et qui sont définis dans les modules d'objets publics peuvent être convertis depuis ou vers un variant, ou passés à des fonctions à liaison tardive"

Pour l'instant la solution est de faire :

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
 
Option Explicit
Option Base 1
 
Type tField
    attr1 As String
    attr2 As Date
End Type
Type tTable
    attr1 As String
    attr2 As Date
End Type
 
Sub main()
    Dim arrFields() As tField
    Dim field As tField
    Dim arrTables() As tTable
    Dim table As tTable
 
    field.attr1 = "test"
    field.attr2 = Date
    table.attr1 = "test"
    table.attr2 = Date
 
    arrPushField arrFields, field
    arrPushTable arrTables, table
End Sub
 
Private Sub arrPushField(arr() As tField, el As tField)
    If isErasedArrayField(arr) Then
        ReDim arr(1)
    Else
        ReDim Preserve arr(UBound(arr) + 1)
    End If
    arr(UBound(arr)) = el
End Sub
Private Sub arrPushTable(arr() As tTable, el As tTable)
    If isErasedArrayTable(arr) Then
        ReDim arr(1)
    Else
        ReDim Preserve arr(UBound(arr) + 1)
    End If
    arr(UBound(arr)) = el
End Sub
Private Function isErasedArrayField(arr() As tField) As Boolean
    Dim a&
    On Error GoTo ieaError
    a = UBound(arr)
    isErasedArrayField = False
    Exit Function
ieaError:
isErasedArrayField = True
End Function
Private Function isErasedArrayTable(arr() As tTable) As Boolean
    Dim a&
    On Error GoTo ieaError
    a = UBound(arr)
    isErasedArrayTable = False
    Exit Function
ieaError:
isErasedArrayTable = True
End Function

Mais ça va vite devenir très lourd... Là je n'ai que deux fonctions mais je risque d'en avoir un paquet...

Quelqu'un a-t-il une astuce pour surcharger les fonctions en vba ?


PS : sachant que je ne créé pas un module de classe par type parce que ça devient vite très lourd également (voir pire) et je ne suis pas sûr de résoudre le problème.

[Invité]

bonjour,
tu as 2 option!
tu peux passer en paramètres un objet ParamArray dan ce cas tu dois scanner le tableau V et scanner les tableau a,b,c,d en n’oubliant pas d'identifier le type de données

Code :

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

TypeName(MyVariable(1))

soit utiliser de paramètre Optionnels!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test(ParamArray V() As Variant)
 
End Sub
 
Sub test2(Optional a, Optional b, Optional c, Optional d)
 
End Sub
 
Sub test3()
  test Array(1, 2, 3, 4), Array(4, 5, 6), Array(7, 8, 9), "toto"
  test2 a:=1, b:=2, c:=3, d:=4
    test2 a:=1, b:=2
End Sub

[cerede2000]

Bonjour à toi,

Malheureusement à part Variant pas de surcharge en VBA.....

[Philippe PONS]

Salut,

en VBA, c'est de la POO très réduite.
Pas de surcharge, ni d'interface, ni d'héritage, etc...

[mathspountz]

Bonjour à toi,

Malheureusement à part Variant pas de surcharge en VBA.....

Salut,

en VBA, c'est de la POO très réduite.
Pas de surcharge, ni d'interface, ni d'héritage, etc...

Mais pourquoi l'une des plus puissantes société du monde nous inflige ça ?
Ils ont le droit de faire évoluer vba comme php l'a fait par exemple...



Rdurupt : pensais-tu à quelque chose comme ça ?

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
 
Sub main()
    Dim arrFields() As tField
    Dim field As tField
    Dim arrTables() As tTable
    Dim table As tTable
 
    field.attr1 = "test"
    field.attr2 = Date
    table.attr1 = "test"
    table.attr2 = Date
 
    arrPush arrFields, field
    arrPush arrTables, table
End Sub
 
 
Private Sub arrPush(ParamArray arr())
    Dim arrTmp(), i&
    If isErasedArray(arr(0)) Then
        ReDim arrTmp(1)
        arr(0) = arrTmp
    Else
        ReDim arrTmp(UBound(arr(0)) + 1)
        For i = 1 To UBound(arr(0))
            arrTmp(i) = arr(0)(i)
        Next i
    End If
    arrTmp(UBound(arrTmp)) = arr(1)
    arr(0) = arrTmp
End Sub
Private Function isErasedArray(ParamArray arr()) As Boolean
    Dim a&
    On Error GoTo ieaError
    a = UBound(arr(0))
    isErasedArray = False
    Exit Function
ieaError:
isErasedArray = True
End Function

Car j'ai le même message d'erreur :

"Erreur de compilation: Seuls les types définis par l'utilisateur et qui sont définis dans les modules d'objets publics peuvent être convertis depuis ou vers un variant, ou passés à des fonctions à liaison tardive"

[cerede2000]

Je suis totalement d'accord avec toi et j'aurais même bien vu un virage de VBA vers C# .net !
Tout en gardant la possibilité pour rétrocompatbilité de faire du VBA mais donner le choix de classeur nouvelle génération avec un vrai langage des années 2010...

[Invité]

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
 
For i =0 to ubound(arr)
   if typenme(arr(i)) ="array"  then
      for x = 0 to ubound(arr(i))
        msgbox arr(i)(x)
      next
   end if
 
if typenme(arr(i)) ="range"  then
      for x = 1 to arr(i).cells.count
 
        msgbox arr(i)(x)
      next
   end if
Next

[mathspountz]

Merci Rdurupt mais le problème ne vient pas de la manière de traiter les arguments contenus dans ParamArray mais d'une erreur de compilation donc je ne peux même pas lancer le code.
Le problème vient bien de l'appel de la fonction et non de la fonction elle même...

Une fois cette erreur contournée, je pense pouvoir me débrouiller pour traité mes données en fonction de leur type.

[Invité]

Il faut absolument typer en variant même si paradoxalement les variables non typer son de variant!
ParamArray arr() as varaintÉdite: Nom pas besoin de typer:
http://www.developpez.net/forums/d14...a/#post7804210

Je viens d comprendre le problème

A l'intérieur d'un module de classe la définition des types ne peuvent être que privé! Ce qui t'interdit d'utiliser ce le type en question à extérieur du module!

Soit il n'est utile que dans le module et tu le défini en privé, ou tu le défini en public dans un module standard!

On est effectivement bien loin du .net alors on compose!

[mathspountz]

Bon j'abandonne je vais faire mon programme en procédurale dégueulasse, ensuite je démissionne et je cherche un boulot dans le Web XD

Merci à tous pour vos réponses !

[cerede2000]

Et la ton chez passe par ce forum, il reconnait le code que t'est en train de faire pour lui et te convoque dans son bureau

[Invité]

Bonjour,
pourquoi tu ne développerais pas ton programme en .net, et les utilisateur manipulerais ton fichier xls dans ton .exe?

ou ça (références Excel) mais j'ai jamais testé!


de toutes les façons vba dispose que de notion de classe (embryonnaire) , il méritait de devenir un grand langage! mais la réputation de langage instinctif pour développeur spaghettis du dimanche, initié par Microsoft lui même, l'a complètement discrédité!

En revanche tu peut définir un autre module de classe et ne lui affecté que de le propriétés Property ou variable public et l'utiliser comme un type!

Et ce ClsType passera sen problème dans tes méthodes!

[mathspountz]

C'est tentant mais je ne connais pas bien .NET ni visual studio après ça serait justement l'occasion de m'y mettre mais bon..

Etape 1) Faire copain copain avec un mec du support pour qu'il m'installe visual studio (express) (car je ne suis pas admin de mon poste)
Etape 2) Apprendre le C# (j'avais fais le tuto à l'époque mais ça s'oublie vite quand tu n'utilises pas)
Etape 3) Quand je m'en vais, j'explique à mon chef que pour me remplacer il va falloir qu'il trouve un dev .NET (= + cher !) parce que j'ai pris des initiatives XD

Sinon à la base je voulais créer un mini BO (Business Object) qui permette à des utilisateurs ne connaissant pas SQL de requêter plusieurs fichiers Excel/csv voir base access (on verra pour la V2) stockés dans un réseau partagé avec jointures etc, via une interface simple.

C'est pour ça que je voudrais bien le ficeler en POO plutôt qu'en procédurale.

En attendant je vais faire des recherche sur manipulation d'ADODB en C# on sait jamais ça se trouve c'est facile !

[cerede2000]

Ouaou !
Beau projet !
Mais à mon avis en VBA Excel........
Et il te faudra quand même un peu de temps, un QueryBuilder ne se fait pas en 3 coup de cuillère à pot

[Invité]

Code Classe adodb :

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
 
 
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 OpenRecordSetParametre(Sql, Param)
Dim Commande
Dim Params
Set Commande = CreateObject("ADODB.Command")
Dim MyParameter
Set MyParameter = CreateObject("ADODB.Parameter")
Set Commande.ActiveConnection = Connexion
Commande.CommandText = "select Requête2.* from Requête2;"
 Commande.CommandType = adCmdText
 
 Set MyParameter = Commande.CreateParameter("[NumJob]", adNumeric)
         MyParameter.Value = 10
Commande.Parameters.Append MyParameter
 
 
 
'aa.Parameters.Append("MyRef") = "243410M660"
Set Rs2 = Commande.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

Code Même chose en vb.net :

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
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
 
Imports System.Data
Imports NDbUnit.Core.SqlLite
Imports System.Runtime.InteropServices
Public Class ClsAdodbRd
    Public Structure ParmCmd
        Public Name As String
        Public Type As VarAdodb
        Public Direction As VarAdodb
        Public Size As Long
        Public Value As String
    End Structure
    Public Enum VarAdodb
        adAddNew = 16778240
        adAffectAllChapters = 4
        adAffectCurrent = 1
        adAffectGroup = 2
        adApproxPosition = 16384
        adArray = 8192
        adAsyncConnect = 16
        adAsyncExecute = 16
        adAsyncFetch = 32
        adAsyncFetchNonBlocking = 64
        adBigInt = 20
        adBinary = 128
        adBookmark = 8192
        adBookmarkCurrent = 0
        adBookmarkFirst = 1
        adBookmarkLast = 2
        adBoolean = 11
        adBSTR = 8
        adChapter = 136
        adChar = 129
        adClipString = 2
        adCmdFile = 256
        adCmdStoredProc = 4
        adCmdTable = 2
        adCmdTableDirect = 256
        adCmdText = 1
        adCmdUnknown = 8
        adCollectionRecord = 1
        adCompareEqual = 1
        adCompareGreaterThan = 2
        adCompareLessThan = 0
        adCompareNotComparable = 4
        adCompareNotEqual = 3
        adCopyAllowEmulation = 4
        adCopyNonRecursive = 2
        adCopyOverWrite = 1
        adCopyUnspecified = -1
        adCreateCollection = 8192
        adCreateNonCollection = 0
        adCreateOverwrite = 67108864
        adCreateStructDoc = -2147483648
        adCriteriaAllCols = 1
        adCriteriaKey = 0
        adCriteriaTimeStamp = 3
        adCriteriaUpdCols = 2
        adCRLF = -1
        adCurrency = 6
        adDate = 7
        adDBDate = 133
        adDBTime = 134
        adDBTimeStamp = 135
        adDecimal = 14
        adDefaultStream = -1
        adDelayFetchFields = 32768
        adDelete = 16779264
        adDouble = 5
        adEditAdd = 2
        adEditDelete = 4
        adEditInProgress = 1
        adEditNone = 0
        adEmpty = 0
        adErrBoundToCommand = 3707
        adErrCannotComplete = 3732
        adErrCantChangeConnection = 3748
        adVarChar = 200
        adParamInput = 1
    End Enum
    Public Enum CommAdo
        adCmdFile = 256
        adCmdStoredProc = 4
        adCmdTable = 2
        adCmdTableDirect = 521
        adCmdText = 1
        adCmdU
        nknown = 8
    End Enum
 
    'Public Enum MyAdo
    '    ACCESS97 = 1
    '    ACCESS2000 = 2
    '    ACCESS2012 = 13
    '    ODBC = 4
    '    ORACLE = 5
    '    SQLSERVER_NT4 = 12
    '    SQLSERVER2005 = 6
    '    SQLServer2008R2 = 7
    '    SQLite = 8
    '    SQLite3 = 9
    '    CSV = 10
    '    Excel8 = 11
    'End Enum
    Private _Cn As Object = Nothing
    Private TYPEBASE As MyAdo
    Private BASE As String = ""
    Private MonServer As String = ""
    Private MonUser As String = ""
    Private MonPassword As String = ""
    Private DirecCn As Boolean = False
    Public Property ConnexionDirect As Boolean
        Set(ByVal value As Boolean)
            DirecCn = value
            If value = False Then CloseConnection() Else OpenConnetion()
        End Set
        Get
            Return DirecCn
        End Get
    End Property
    Public ReadOnly Property Status As Boolean
        Get
            Try
                Return _Cn.State
            Catch ex As Exception
                Return False
            End Try
        End Get
    End Property
 
 
    Public Property ConectString As Object
        Get
            Return GenereCSTRING()
        End Get
        Set(ByVal value As Object)
 
        End Set
    End Property
    Public ReadOnly Property Connexion As AdoDbRd
        Get
            Return _Cn
        End Get
        'Set(ByVal value As Object)
 
        'End Set
    End Property
 
    Public Property Password As String
        Get
            Return MonPassword
        End Get
        Set(ByVal value As String)
            MonPassword = value
        End Set
    End Property
    Public Property User As String
        Get
            Return MonUser
        End Get
        Set(ByVal value As String)
            MonUser = value
        End Set
    End Property
    Public Property Server As String
        Get
            Return MonServer
        End Get
        Set(ByVal value As String)
            MonServer = value
        End Set
    End Property
    Public Property Database As String
        Get
            Return BASE
        End Get
        Set(ByVal value As String)
            BASE = value
        End Set
    End Property
 
    Public Property BASETYPE As MyAdo
        Get
            Return TYPEBASE
        End Get
        Set(ByVal value As MyAdo)
            TYPEBASE = value
        End Set
    End Property
    Public Sub New()
        TYPEBASE = New MyAdo
    End Sub
    Private Function GenereCSTRING() As String
 
        Select Case TYPEBASE
            Case MyAdo.ACCESS97
                Return "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & BASE
            Case MyAdo.ACCESS2000
                Return "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BASE & ";Persist Security Info=False"
            Case MyAdo.ACCESS2012
                Return "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";"
            Case MyAdo.ODBC
                Return "Provider=MSDASQL.1;Password=" & MonPassword & ";Persist Security Info=True;User ID=" & MonUser & ";Data Source=" & BASE
            Case MyAdo.ORACLE
                Return "Provider=OraOLEDB.Oracle.1;Password=" & MonPassword & ";Persist Security Info=True;User ID=" & MonUser & ";Data Source=" & BASE
            Case MyAdo.SQLSERVER_NT4
                Return "Provider=SQLOLEDB.1;Password=" & MonPassword & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & BASE & ";Data Source=" & MonServer
            Case MyAdo.SQLSERVER2005
                Return "Provider=SQLOLEDB.1;Password=" & MonPassword & ";Persist Security Info=True;User ID=" & MonUser & ";Initial Catalog=" & BASE & ";Data Source=" & MonServer
            Case MyAdo.SQLServer2008R2
                Return "Provider=SQLNCLI;Server=" & MonServer & ";Database=" & BASE & ";UID=" & MonUser & ";PWD=" & MonPassword & ";"
            Case MyAdo.SQLite
                Return "Provider=OleSQLite.SQLiteSource.3; Data Source=" & BASE
                Return "Driver={SQLite ODBC (UTF-8) Driver};Database=" & BASE & ";StepAPI=;Timeout="
            Case MyAdo.SQLite3
                Return "Driver={SQLite3 ODBC Driver};Database=" & BASE & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"
            Case MyAdo.CSV
                Return "ODBC;DBQ=" & Server & ";Driver={Microsoft Text Driver (*.txt; *.csv)}; " & "DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferS"
            Case MyAdo.Excel8
                Return "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BASE & ";Extended Properties=Excel 8.0;"
            Case Else
                Return "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"
 
        End Select
    End Function
    Public Function RetournRep()
        Dim t() As String = BASE.Split("\")
        Return BASE.Replace(t(t.Count), "")
    End Function
    Public Function RetournFichier()
        Dim t() As String = BASE.Split("\")
        Return t(t.Count)
    End Function
    Private Function OpenConnetion() As Boolean
        'Ouvre une connexion à  la base de données.
        _Cn = GetObject("ADODB.Connection")
        _Cn.CommandTimeout = 0.000001
        Try
            _Cn.Open(GenereCSTRING) 'ConnecString
        Catch ex As Exception
            Return False
        End Try
        _Cn.CommandTimeout = 14400
        Return True
    End Function
    Private Function CloseConnection() As Boolean
        'Referme la cn
        Try
            _Cn.Close()            
        Catch ex As Exception
            Return False
        End Try
        CloseConnection = False
        _Cn = Nothing
        Return True
    End Function
    Public Function OpenRecordSet(ByVal Sql) As Object
        Dim RS As Object = Nothing
        'Retourne un RecordeSett
        Dim myObject As New Object
        Dim myCheck As Boolean
        myCheck = myObject Is _Cn.State
        If myCheck = False Then
            If OpenConnetion() = False Then Return Nothing
        End If
        RS = CreateObject("ADODB.Recordset")
        Try
            RS.Open(Sql, _Cn, 1, 3)
            Return RS
        Catch ex As Exception
            Return Nothing
        End Try
        Return RS
    End Function
 
    'Cloture le RecordSet
    Public Function CloseRecordSet(ByVal RS)
        On Error Resume Next
        RS.Close()
        CloseRecordSet = Nothing
        On Error GoTo 0
    End Function
    'Pour les requêtes directe
    Public Function Execute(ByVal Sql) As Boolean
        Dim myObject As New Object
        Dim myCheck As Boolean
        myCheck = myObject Is _Cn.State
        If myCheck = False Then
            If OpenConnetion() = False Then Return False
        End If
        Try
            _Cn.Execute(Sql)
        Catch ex As Exception
            Return False
        End Try
        Return True
    End Function
 
    Public Function OpenCommande(ByVal Sql As String, ByVal Param() As ParmCmd, ByVal CmType As CommAdo) As Object
        Dim myObject As New Object
        Dim myCheck As Boolean
        myCheck = myObject Is _Cn.State
        If myCheck = False Then
            If OpenConnetion() = False Then Return Nothing
        End If
        Dim sCmd As Object = CreateObject("Adodb.Command")
        Dim sParam As Object = Nothing
        sCmd.CommandType = CmType
        sCmd.ActiveConnection = _Cn
        sCmd.CommandText = Sql
        For i = 0 To Param.Count - 1
            sParam = sCmd.CreateParameter(Param(i).Name, Param(i).Type, Param(i).Direction, Param(i).Size, Param(i).Value)
            sCmd.Parameters.Append(sParam)
        Next
 
        Return sCmd.Execute()
    End Function
    Public Function OpenCommandeRecordSet(ByVal Sql As String, ByVal Param() As ParmCmd, ByVal CmType As CommAdo) As Object
        Dim myObject As New Object
        Dim myCheck As Boolean
        myCheck = myObject Is _Cn.State
        If myCheck = False Then
            If OpenConnetion() = False Then Return Nothing
        End If
        Dim sCmd As Object = CreateObject("ADODB.Command")
        Dim sParam As Object = Nothing
        sCmd.CommandType = CmType
        sCmd.ActiveConnection = _Cn
        sCmd.CommandText = Sql
        For i = 0 To Param.Count - 1
            If Param(i).Size <> 0 Then
                'Durupt
                sParam = sCmd.CreateParameter(Param(i).Name, Param(i).Type, Param(i).Direction, Param(i).Size, Param(i).Value)
                sCmd.Parameters.Append(sParam)
            End If
        Next
 
        Dim RstRecordSet = CreateObject("ADODB.Recordset")
        Try
            With RstRecordSet
                .CursorType = 3
                .CursorLocation = 3
                .LockType = 3
                .Open(sCmd)
            End With
        Catch ex As Exception
            Return Nothing
        End Try
 
        Return RstRecordSet
    End Function
    Public Function OpenCommandDataSet(ByVal Sql As String, ByVal Param() As ParmCmd, ByVal CmType As CommAdo, ByVal Name As String) As Object
         Dim myObject As New Object
        Dim myCheck As Boolean
        myCheck = myObject Is _Cn.State
        If OpenConnetion() = False Then Return Nothing
 
        Dim da As New System.Data.OleDb.OleDbDataAdapter()
        Dim ds As New DataSet()
        Dim Rs As Object = OpenCommandeRecordSet(Sql, Param, CmType)
        da.Fill(ds, Rs, Name)
        Return ds
    End Function
 
 
    Private Function CreateObject(ByVal app As String) As Object
        Dim AppType As Object = Type.GetTypeFromProgID(app)
        Dim ApplInst As Object = Activator.CreateInstance(AppType)
        Return ApplInst
    End Function
    Public Function GetObject(ByVal App As String) As Object
        Try
            Return Marshal.GetActiveObject(App)
        Catch ex As Exception
            Return CreateObject(App)
        End Try
 
    End Function
 
 
End Class

Code Public Module VariableGlobal :

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
Public Module VariableGlobal
    Public Enum MyAdo
        ACCESS97 = 1
        ACCESS2000 = 2
        ACCESS2012 = 13
        ODBC = 4
        ORACLE = 5
        SQLSERVER_NT4 = 12
        SQLSERVER2005 = 6
        SQLServer2008R2 = 7
        SQLite = 8
        SQLite3 = 9
        CSV = 10
        Excel8 = 11
    End Enum
    Friend Con As ClsAdodbRd
End Module

[cerede2000]

@rdurupt : Classe cette class !!
Je met de côté

[mathspountz]

Bien d'accord ça peut faire gagner du temps merci beaucoup !

Sinon j'ai déjà fais un outil similaire en php/js, il tapait dans une base mySql + x fichiers csv fourni par le user donc j'ai déjà en tête toute l'archi ça devrait pouvoir se faire.

Si j'y arrive je posterai dans contribution

[Invité]

il faut noté que dans la version vb.net j'ai implémenté la méthode créateObject et getobject via marshal et intérop car ça n'existe pas dans .net .

je pense que ma classe adodb la récupère par héritage mais je n'en suis plus sur!

Edite: non c'est dans la classe

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 Private Function CreateObject(ByVal app As String) As Object
        Dim AppType As Object = Type.GetTypeFromProgID(app)
        Dim ApplInst As Object = Activator.CreateInstance(AppType)
        Return ApplInst
    End Function
    Public Function GetObject(ByVal App As String) As Object
        Try
            Return Marshal.GetActiveObject(App)
        Catch ex As Exception
            Return CreateObject(App)
        End Try
 
    End Function

[cerede2000]

@rdurupt : Par contre en .Net... Utilisé ADODB.Command je pense que ce n'est pas le top, il existe des classe .Net plus optimisé quand même.
Mais certes ça demandera plus de code !

[Invité]

Adodb d'une manière générale est à proscrire en .net!

oui mais les objet sont plus spécialisé et je travail sur différant type de base!

le polymorphisme je connais mais ça urgeait!

pour répondre à notre amis la surcharge je connais mais c'est pondérale!