ALTER TABLE MaTable ADD COLUMN MonChampID COUNTER

CREATE TABLE MaTable ( MonChampID COUNTER, MonAutreChamp Text(10))

Function NextID(LeChamp As String, LaTable As String) As Long 
 '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 'Fonction renvoyant le prochain Identifiant, en fonction des valeurs existantes dans une table. 
 'Arguments : 
 '    LeChamp => Nom du champ Identifiant numérique Long concerné 
 '    LaTable => Nom de la table contenant cet identifiant 
 'Retour    : 
 '    1 s'il n'y a rien dans la table 
 '    Le Nombre maximum +1 s'il y a une suite ininterrompue de nombres 
 '    La valeur du nombre manquant en cas de trou. 
 '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
    Dim sSQL    As String 
    Dim rs      As DAO.Recordset 
    Dim n       As Long 
    
    'Chaîne SQL en fonction de LeChamp et de LaTable, retournant NULL ou le numéro du trou 
    sSQL = "Select Min([" & LECHAMP & "]-1) As NextID From " & LATABLE & " As T1 "
    sSQL = sSQL & "Where ((([" & LECHAMP & "]-1)>0) And (((Select [" & LECHAMP & "] "
    sSQL = sSQL & "From " & LATABLE & " T2 "
    sSQL = sSQL & "Where T2.[" & LECHAMP & "]=T1.[" & LECHAMP & "]-1)) Is Null));" 
    Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot) 
    'Nbre d'enregistrements dans laTable 
    n = DCount("[" & LeChamp & "]", "[" & LaTable & "]") 
    If n = 0 Then               'S'il n'y a pas d'enregistrements, mettre 1 
        NextID = 1 
    ElseIf IsNull(rs(0)) Then   'Si la requête ne renvoie rien, incrémenter de 1 le maximum 
        NextID = DMax("[" & LeChamp & "]", "[" & LaTable & "]") + 1 
    Else 
        NextID = rs(0)          'Sinon, il y a un trou. Renvoyer la valeur du trou 
    End If 
End Function

Function ModifTable()
 'gestion d'erreur pour garantir la mise à jour de l'écran
On Error GoTo GestionErreur
 'empêche la mise à jour de l'écran
DoCmd.Echo False
 'ouvre la table en mode création
DoCmd.OpenTable "maTable", acViewDesign
 'change la propriété caption du champ 'colonne2'
CurrentDb.TableDefs("maTable")("colonne2").Properties("caption").Value = "nouvelle légende"
 'ferme la table en sauvegardant
DoCmd.Close acTable, "maTable", acSaveYes
Exit_function:
DoCmd.Echo True
Exit Function
GestionErreur:
MsgBox Err.Description
Resume Exit_function
End Function 

Alter Table [TABLE] Alter Column [NOMCHAMP] [Type];

Function NbDeChamp(NomTable as string) As Integer
On error goto err
Dim Db As DAO.Database
Dim T As DAO.TableDef
Set Db=CurrentDb
Set T=Db.Tabledefs(NomTable)
NbDeChamp=T.fields.count
err:
End Function

MsgBox NbDeChamp("essai")

Sub addDefault () 
    Dim fldDate As Field
    Set fldDate = CurrentDb.TableDefs!Clients.CreateField("DateSignature",dbDate) 
    fldDate.DefaultValue= "Now()" 
    CurrentDb.TableDefs("Clients").Fields.Append fldDate 
End Sub

ALTER TABLE Clients ADD COLUMN chkSigne YESNO; 

Function RenommerChamp(NomTable As String, Ancien As String, Nouveau As String) As Boolean
On Error GoTo err:
Dim MCat As New ADOX.Catalog
Dim MTable As ADOX.Table
Dim MField As ADOX.Column
Set MCat.ActiveConnection = CurrentProject.Connection
Set MTable = MCat.Tables(NomTable)
Set MField = MTable.Columns(Ancien)
MField.Name = Nouveau
RenommerChamp = True
err:
Set MCat = Nothing
Set MTable = Nothing
Set MField = Nothing
End Function

MsgBox RenommerChamp("produit2", "stock", "Stock1")

Public sub RenommerChamp(PTable as string,POld as string ,PNew as String)
On error goto err:
Dim VTable as DAO.Tabledef
Dim VField as DAO.Field
set VTable=currentDb.TableDefs(PTable)
set VField=VTable.Fields(POld)
VField.Name=PNew
set VField=Nothing
set VTable=Nothing
exit sub
err:
msgbox "L\'action  renommer le champ a échouée"
End Sub

RenommerChamp "MaTable","test","essai"

Function SupprimerChamp(NomTable As String, NomChamp) As String
On Error GoTo err
Dim MCat As New ADOX.Catalog
Set MCat.ActiveConnection = CurrentProject.Connection
MCat.Tables(NomTable).Columns.Delete (NomChamp)
SupprimerChamp = True
err:
Set MCat = Nothing
End Function

MsgBox SupprimerChamp("Produit", "C1")

Function ExisteChamp(NomTable As String, NomChamp As String) As Boolean
On Error GoTo err:
Dim MCat As New ADOX.Catalog
Dim MTable As ADOX.Table
Dim MField As ADOX.Column
Set MCat.ActiveConnection = CurrentProject.Connection
Set MTable = MCat.Tables(NomTable)
Set MField = MTable.Columns(NomChamp)
ExisteChamp = True
err:
Set MCat = Nothing
Set MTable = Nothing
Set MField = Nothing
End Function

Debug.print ExisteChamp("Produit", "stock")

Forms!MonFormulaire!Téléphone.InputMask = "##-##-##-##-##"

Dim db As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field
Dim strDescription As String

Set db = CurrentDb

On Error GoTo GestionErreur

For Each tdf In db.TableDefs
  For Each fld In tdf.Fields
    strDescription = fld.Properties("Description")
    If MsgBox("Nom : " & fld.Name & vbCrLf & vbCrLf & _
              "Description : " & strDescription, _
              vbOKCancel, _
              "Champs de la table : " & tdf.Name) = vbCancel Then Exit Sub
  Next fld
Next tdf

Set fld = Nothing
Set tdf = Nothing
Set db = Nothing

Exit Sub

GestionErreur:
Select Case Err.Number
  Case 3270
    strDescription = ""
    Resume Next
  Case Else
    MsgBox "Erreur inconnue.", vbCritical
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
exit sub
End Select

Public Function NomClePrimaire(NomTable As String) As String
On Error GoTo err
Dim oInd As DAO.Index
Dim oDb As DAO.database
Dim oTbl As DAO.tabledef
Dim oFld As DAO.Field
Set oDb = CurrentDb
Set oTbl = oDb.TableDefs(NomTable)
'Parcours les index
For Each oInd In oTbl.Indexes
'S'il s'agit d'une clé primaire, alors traiter
If oInd.Primary Then
    For Each oFld In oInd.Fields
        NomClePrimaire = NomClePrimaire & oFld.Name & ","
    Next oFld
    Exit For
End If
Next oInd
'Enleve la dernière virgule
NomClePrimaire = Left(NomClePrimaire, Len(NomClePrimaire) - 1)
Exit Function
err:
End Function

Msgbox NomClePrimaire("MaTable")

ALTER TABLE <table1> ALTER COLUMN <champ1> <typeChamp1> DEFAULT <valeurParDéfaut>

Sub PrimaryKeyADO()
Dim oCat As ADOX.Catalog
Dim oTbl As ADOX.Table
Dim oKey As ADOX.Key
'Instancie un nouvel objet ADOX.Catalog
Set oCat = New ADOX.Catalog
'Lie le catalogue à la base de données
Set oCat.ActiveConnection = CurrentProject.Connection
'Accède à la table
Set oTbl = oCat.Tables("MaTable")
'Crée une nouvelle clé primaire
Set oKey = New ADOX.Key
'Affecte les différentes propriétés
With oKey
    .Name = "PK_MaTable"
    .Type = adKeyPrimary
    'Ajoute les trois champs à la clé primaire
    With .Columns
        .Append "champ1"
        .Append "champ2"
        .Append "champ3"
    End With
End With
'Ajoute la clé primaire à la table
oTbl.Keys.Append oKey
End Sub

Sub PrimaryKey()
Dim oDb As DAO.Database
Dim oTbl As DAO.TableDef
Dim oIdx As DAO.Index
'Instancie un objet Database courant
Set oDb = CurrentDb
'Accède à la table
Set oTbl = oDb.TableDefs("MaTable")
'Crée la clé primaire sur les champs :
'champ1, champ2, champ3
Set oIdx = oTbl.CreateIndex("PK_MaTable")
With oIdx
    .Fields.Append .CreateField("Champ1")
    .Fields.Append .CreateField("Champ2")
    .Fields.Append .CreateField("Champ3")
    .Primary = True
    .Required = True
End With
oTbl.Indexes.Append oIdx
End Sub

Dim db As DAO.Database
Dim fld As DAO.Field
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.TableDefs("essai")
Set fld = tbl.Fields("c1")
fld.OrdinalPosition = 3

Texte : VARCHAR (255 caractères), CHAR(n) ou TEXT(n) (n caractères), LONGTEXT (mémo, 32K max.) ;
Fichier binaire : LONGBINARY (Objet OLE) ;
Compteur : COUNTER (NuméroAuto).Booléen : BIT ;
Nombre entier : SHORT (entier), SMALLINT (entier), LONG (entier long), INTEGER (entier long), BYTE (octet) ;
Nombre réel : SINGLE (réel simple), DOUBLE (réel double), NUMERIC (réel double) ;
Monétaire : CURRENCY, MONEY ;
Date/Heure : DATE, TIME, DATETIME ;

CurrentProject.Connection.Execute "ALTER TABLE TABLE1 ADD COLUMN ESSAI3 DECIMAL(18,0)"

Sub NoNull()
Dim db As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field
Dim strDescription As String
 
Set db = CurrentDb
Set tdf = db.TableDefs("maTABLE")
 
For Each fld In tdf.Fields
    
    If fld.Required = True Then
 
        If IsNull(Me.Controls(fld.Name)) Then MsgBox "REMPLISSEZ MOI LE CHAMP" & fld.Name
 
    End If
 
Next fld
 
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
 
Exit Sub

Sub ranger()
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.TableDefs("essai")
For Each fld In tbl.Fields
fld.OrdinalPosition = 1
Next
End Sub

Sub ranger()
Dim db As DAO.Database
Dim fld As DAO.Field
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.TableDefs("essai")
For Each fld In tbl.Fields
If IsPrimary(fld, tbl) Then
fld.OrdinalPosition = 1
Else
fld.OrdinalPosition = 2
End If
Next
End Sub
Function IsPrimary(fld As DAO.Field, tbl As DAO.TableDef) As Boolean
On Error GoTo err
Dim ind As DAO.Index
Dim tfld As DAO.Field
For Each ind In tbl.Indexes
If ind.Primary Then
Set tfld = ind.Fields(fld.Name)
IsPrimary = True
End If
Next ind
err:
End Function