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
| Public Sub CreeChamp(odb As Object, table As String, nv As Boolean, champ As String, Typ As Integer, lg As Integer, auto As Boolean _
, req As Boolean, vide As Boolean, Defaut As String, Valid As String, Descr As String, Optional clef As String = "" _
, Optional RT As String = "", Optional RC As String = "")
If Not Mode_debug Then On Error GoTo err:
Dim oTbl As DAO.TableDef, oFld As DAO.Field, prp As DAO.Property
Dim FSO As New Scripting.FileSystemObject, FileText As Scripting.TextStream, T As String
102 If nv Then
'Ouvre le .ini et ajoute une ligne - 12.2f nom variable
104 Set FileText = FSO.OpenTextFile(Planet_ini, ForAppending, False)
106 FileText.WriteLine table & Space(15 - Len(table)) & "=planetDB.mdb" '12.0a
108 FileText.Close: Set FileText = Nothing
110 Set FSO = Nothing
End If
112 If nv Then Set oTbl = odb.CreateTableDef(table) Else Set oTbl = odb.TableDefs(table)
114 If Typ = dbText Then Set oFld = oTbl.CreateField(champ, Typ, lg) Else Set oFld = oTbl.CreateField(champ, Typ)
116 If auto Then oFld.Attributes = dbAutoIncrField 'Définit le champ en numero_auto
118 oFld.Required = req 'Null interdit ?
120 If Typ = dbText Then oFld.AllowZeroLength = vide 'chaine vide autorisée ?
122 If Len(Defaut) > 0 Then oFld.DefaultValue = Defaut
124 If Len(Valid) > 0 Then oFld.ValidationRule = Valid
126 oTbl.Fields.Append oFld 'Ajoute le champ à la table
128 If nv Then odb.TableDefs.Append oTbl 'Ajoute la table à la base de données
130 If Nz(Descr) > " " Then
132 Set prp = oFld.CreateProperty("Description", dbText, Descr)
134 oFld.Properties.Append prp
End If
136 If Typ = dbBoolean Then
138 Set prp = oFld.CreateProperty("Format", dbText, "Yes/No")
140 oFld.Properties.Append prp 'Format oui/non
142 Set prp = oFld.CreateProperty("DisplayControl", dbInteger, 106)
144 oFld.Properties.Append prp 'case à cocher
End If
146 oTbl.Fields.Refresh 'Rafraichit la collection
148 odb.TableDefs.Refresh
150 If Len(clef) = 1 Then Call CreeIndex(odb, table, champ, clef)
152 If Len(RT) > 0 Then Call CreeRelation(odb, table, champ, RT, RC)
154 Set prp = Nothing
156 Set oFld = Nothing
158 Set oTbl = Nothing
Exit Sub
err: Call message("Erreur " & err.Number & "/" & Erl & " dans fonctions.CreeChamp sur " & table & "." & champ & " : " & err.description)
End Sub |
Partager