Bonjour,

Je voudrais utiliser le code de la discussion de oleff
http://www.developpez.net/forums/d91...bles-base-vba/

J’ai créé la Table tblTablesAttachees avec un seul champ TablesAttachees, et j’ai inscrit les noms des tables attachées.

Lorsque je lance le code j’ai une erreur « incompatibilite de type » après exit Function de la Function Table_Existe.

Et je ne comprends pas pour quelles raisons j’ai cette erreur.

Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = strrep
Exit Function


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 Commande0_Click()
Dim rst As Recordset
Dim strCheminBd As String
strCheminBd = CurrentProject.Path
strCheminBd = strCheminBd & "\" & "Comptoir_princip.mdb"
'Ouverture du recordset rst des tables à éxaminer...
Set rst = CurrentDb.OpenRecordset("tblTablesAttachees")
If table_existe(rst!TablesAttachees) Then
   detachT rst!NomTablesAttachees
   CurrentDb.TableDefs.Refresh
   attachT rst!NomTablesAttachees, rst!strCheminBd, rst!NomTablesAttachees
End If
rst.MoveNext
End Sub
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
Public Function attachT(ByVal strtable As String, strConnect As String, strSourceTable As String) As Boolean
' Attache une table à la base de données courante, paramètres :
' strtable : nom local de la table à créer
' strconnect : localisation de la base où trouver la table à attacher
' strsourcetable : nom de la table dans la base source
 
On Error GoTo Err_attachT
 
Dim dbsTemp As Database
Dim tdfLinked As TableDef
Dim rstLinked As Recordset
Dim intTemp As Integer
Dim endroit As String
endroit = ";DATABASE=" & strConnect
 
Set dbsTemp = CurrentDb
 
' Crée un objet TableDef, définit ses propriétés
' Connect et SourceTableName en fonction des
' arguments passés et ajoute l'objet à la collection TableDefs.
Set tdfLinked = dbsTemp.CreateTableDef(strtable)
 
tdfLinked.Connect = endroit
tdfLinked.SourceTableName = strSourceTable
dbsTemp.TableDefs.Append tdfLinked
 
' table attachée ?
If table_existe(strtable) <> "no found" Then
    attachT = True
Else
    attachT = False
End If
Exit Function
 
Err_attachT:
    attachT = False
    Exit Function
End Function
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
Public Function detachT(ByVal strtable As String) As Boolean
' Supprime l'attache d'une table dont le nom est passé en paramètre
 
' si la table n'existe pas, inutile d'aller plus loin
If table_existe(strtable) = "no found" Then
    detachT = True
    Exit Function
End If
 
On Error GoTo Err_detachT
 
Dim dbsTemp As Database
Set dbsTemp = CurrentDb
dbsTemp.TableDefs.Delete strtable
Set dbsTemp = Nothing
 
' table détachée ?
If table_existe(strtable) = "no found" Then
    detachT = True
Else
    detachT = False
End If
Exit Function
 
Err_detachT:
    Set dbsTemp = Nothing
    detachT = False
    Exit Function
End Function
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
Public Function table_existe(ByVal strtable As String)
' Est-ce que la table donnée existe dans la base courante ?
On Error GoTo err_table_existe
Dim dbs As Database, tdfLoop As TableDef, strrep As String
Set dbs = CurrentDb
strrep = "no found"
For Each tdfLoop In dbs.TableDefs
    If UCase(tdfLoop.Name) = UCase(strtable) Then
        strrep = strtable
        Exit For
    End If
Next tdfLoop
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = strrep
Exit Function
 
err_table_existe:
Set tdfLoop = Nothing
Set dbs = Nothing
table_existe = "error"
End Function
Merci pour votre aide.

Salutations