DAO Tabledefs - Ajouter une description
Bonjour tout le monde,
J'ai une plusieurs tables déjç créées dans ma base et une table imp_structure_base qui contient l'ensemble de la structure de ma base.
J'aimerais à partir de cette table (imp_structure_base) redéfinir la taille et la description de chaque variable de chaque table de ma base.
Le principe est le suivant, je boucle sur la base et sur les champs de la table.
Une fois la table choisie, je selectionne les enregistrements correspondants aux variables de cette table choisie dans la table imp_structure_base. La correspondance entre le premier champ de la table selectionnée et le premier enregistrement de la table est parfaite et le déplacement aussi.
Le seul probème est que j'arrive pas à modifier la taille du champs sélectionné ni à lui ajouter une description.
Mon code est ci-dessous
Code:
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
| Sub structure()
Dim db As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field
Dim strDescription As String
Dim strVar As String
Dim strType As String
Dim strTable As String
Dim strTaille As String
Dim rst As DAO.Recordset
Dim sql As String
Set db = CurrentDb
On Error GoTo GestionErreur
For Each tdf In db.TableDefs
nom = tdf.Name
sql = "SELECT * FROM IMP_STRUCTURE_BASE WHERE table ='" & nom & " '"
Set rst = db.OpenRecordset(sql, dbOpenDynaset)
rst.MoveLast
cp = rst.RecordCount
Debug.Print (cp & " variables dans :" & nom)
rst.MoveFirst
Debug.Print (" ===== Début du jeu d'enregistrement =====")
For Each fld In tdf.Fields
strTaille = rst.Fields("taille")
strDescription = rst.Fields("description")
fld.Properties("Description") = strDescription
fld.Properties("taille") = strTaille
Debug.Print strDescription & " Taille : " & strTaille
Debug.Print (fld.Name & "--> Traitement pour ->:" & rst.Fields("description"))
rst.MoveNext
Next fld
Next tdf
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Sub
GestionErreur:
strDescription = ""
Resume Next
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Sub
End Sub |
