Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access VBA créer un champ s'il n'existe pas

VBA créer un champ s'il n'existe pas

20 réponses
Avatar
Pat
Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient:: CurrentDb.Execute
"ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas la
syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Pat
J''oubliais il s'agit de tables liées.
Avatar
Pat
J'ai trouvé sur le groupe le code ci-dessous qui m'avais été envoyé par Fred
en son temps. Je n'ai jamais réussi à le faire fonctionner.

J'ai placé ce code dans un module nommé ModAjoutChampTable

J'ai créé une macro AjoutChampTable contenant l'instruction ExécuterCode et
comme Nom de fonction
AjoutChampDansTable("TbleA","Champ1",dbboolean,false,"C:db.mdb")

Je reçois le message Impossible de trouver le nom dbBolean entré dans
l'expression.

Je cale.

Merci de votre aide


--------------------------

Function AjoutChampDansTable(table As String, Champ As String, TypeChamp As
Integer, NumAuto As Boolean, Optional NomBase As String, Optional ValDefT As
String, Optional FormatChamp As Integer, Optional LibelleChamp As String) As
Long
'Nombase chemin complet de la base
On Error GoTo AjoutChampDansTable_Error

Dim bds As Database, CheminBase As String
Dim tdf As TableDef, fld As Field, chp As Field
Dim wrkJet As Workspace

If IsNull(NomBase) Or IsEmpty(NomBase) Or NomBase = "" Then
CheminBase = CurrentDb.Name
Else
CheminBase = NomBase
End If

Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set bds = wrkJet.OpenDatabase(CheminBase)

' Crée un nouvel objet TableDef.
Set tdf = bds.TableDefs(table)

'Creation du champ
Set fld = tdf.CreateField(Champ, TypeChamp)
'Creation du champ auto
If NumAuto And TypeChamp = dbLong Then
fld.OrdinalPosition = 1
fld.Attributes = dbAutoIncrField
End If
'Valeur par defaut texte
If IsNull(ValDefT) Or IsEmpty(ValDefT) Or ValDefT = "" Then
Else
fld.DefaultValue = ValDefT
End If


'activation du champ
tdf.Fields.Append fld


'Libelle Champ
If IsNull(LibelleChamp) Or IsEmpty(LibelleChamp) Or LibelleChamp = ""
Then
Else
Set chp = tdf.Fields(Champ)
Call DéfinirPropriété(chp, "Description", dbText, LibelleChamp)
End If

'Definition du format de champ
If FormatChamp > 0 Then
GoSub FormatDeChamp
End If

Fin:

bds.Close
wrkJet.Close
Set fld = Nothing
Set bds = Nothing
Set chp = Nothing
Set tdf = Nothing
Set wrkJet = Nothing


Exit Function


AjoutChampDansTable_Error:
MsgBox "Error "
'& Err.Number & " (" & Err.Description & ") in procedure
"AjoutChampDansTable of Module Ajout Champ dans Table"
Resume Fin
'==========================================================================­===== ' Création de propriétés pour certains champs
'utilise la fonction DéfinirPropriété du module DéfinirPropriétéAccess
'==========================================================================­===== FormatDeChamp:
Select Case FormatChamp
Case 1
'----------------------------------
'Case a cocher *
'----------------------------------
Set chp = tdf.Fields(Champ) 'acCheckBox = Case à cocher (106)
'Propriété DisplayControl
Call DéfinirPropriété(chp, "DisplayControl", dbInteger, acCheckBox)
Call DéfinirPropriété(chp, "Format", dbText, "True/False")


Case 3
'----------------------------------
'Zone de texte *
'----------------------------------
Set chp = tdf.Fields(Champ) 'acTextBox = Zone de texte
Call DéfinirPropriété(chp, "DisplayControl", dbInteger, acTextBox)


Case 3
'----------------------------------
'Zone de liste *
'----------------------------------
Set chp = tdf.Fields(Champ) 'acListBox = Zone de liste
Call DéfinirPropriété(chp, "DisplayControl", dbInteger, acListBox)


Case 4
'----------------------------------
'Zone de liste Modifiable *
'----------------------------------
Set chp = tdf.Fields(Champ) 'acComboBox = Zone de liste modifiable
Call DéfinirPropriété(chp, "DisplayControl", dbInteger, acComboBox)
Call DéfinirPropriété(chp, "RowSourceType", dbText, "Table/requête")
'"Table/requête", "Liste valeurs" ou "Liste champs"
Call DéfinirPropriété(chp, "RowSource", dbText, "CourrierNumerise")
Call DéfinirPropriété(chp, "ColumnCount ", dbText, "4")
'Call DéfinirPropriété(chp, "ColumnWidths", dbText, "")
Call DéfinirPropriété(chp, "ListWidth", dbText, "12")
Call DéfinirPropriété(chp, "LimitToList", dbboolean, True)


End Select
Return


End Function
'=================================================== 'Call DéfinirPropriété(chp, "Format", dbText, "True/False") '"Yes/No" ou
'"True/False" ou "On/Off"


Function DéfinirPropriété(obj As Object, chNom As String, entType As
Integer, varSetting As Variant) As Boolean
On Error GoTo ErrorDéfinirPropriétéAccess


Dim prp As Property
Const conPropNotFound As Integer = 3270 'Prop non définie.


' Se réfère explicitement à la collection properties.
obj.Properties(chNom) = varSetting
obj.Properties.Refresh
DéfinirPropriété = True


SortieDéfinirPropriétéAccess:
Exit Function


ErrorDéfinirPropriétéAccess:
If Err = conPropNotFound Then
' Crée une propriété, précise le type et définit une valeur
initiale.
Set prp = obj.CreateProperty(chNom, entType, varSetting)
' Ajoute l'objet Property à la collection Properties.
obj.Properties.Append prp
obj.Properties.Refresh
DéfinirPropriété = True
Resume SortieDéfinirPropriétéAccess
Else
MsgBox Err & ": " & Err.Number & vbCrLf & Err.Description
DéfinirPropriété = False
Resume SortieDéfinirPropriétéAccess
End If
End Function
Public Function NoMaj() As Long
NoMaj = DLookup("[IntituléNumérique]", "Paramètres numériques1",
"[NoParamètre]@")
End Function
Avatar
Giorgio_AP
La création d'un champs peut se faire par le code suivant:
Set champs = CurrentDb.TableDefs!nomDeTaTable.CreateField ("nomduchamps",
dbtext, 50)
CurrentDb.TableDefs("nomDeTaTable").Fields.Append champs

Regarde la méthode CreateField dans VB et la propriété name pour tester
l'existence de ton champs dans ta table.

"Pat" a écrit dans le message de news:
437ee69e$0$2144$
Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient:: CurrentDb.Execute
"ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas la
syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------





Avatar
Pat
Merci pour ces infos mais j'ai le message variable non définie, je suppose
qu'il manque une référence mais laquelle?

Je n'ai pas la doc de VB, comment tester si le champ existe.

Merci pour ton aide.

Pat

"Giorgio_AP" <David47(arrobas)Caramail(point)com> a écrit dans le message de
news:
La création d'un champs peut se faire par le code suivant:
Set champs = CurrentDb.TableDefs!nomDeTaTable.CreateField ("nomduchamps",
dbtext, 50)
CurrentDb.TableDefs("nomDeTaTable").Fields.Append champs

Regarde la méthode CreateField dans VB et la propriété name pour tester
l'existence de ton champs dans ta table.

"Pat" a écrit dans le message de news:
437ee69e$0$2144$
Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient:: CurrentDb.Execute
"ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas
la syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------









Avatar
Eric
Bonjour,
Serait-ce Microsoft DAO 3.x Object Library qu'il te faut ?

Merci pour ces infos mais j'ai le message variable non définie, je suppose
qu'il manque une référence mais laquelle?

Je n'ai pas la doc de VB, comment tester si le champ existe.

Merci pour ton aide.

Pat

"Giorgio_AP" <David47(arrobas)Caramail(point)com> a écrit dans le message de
news:

La création d'un champs peut se faire par le code suivant:
Set champs = CurrentDb.TableDefs!nomDeTaTable.CreateField ("nomduchamps",
dbtext, 50)
CurrentDb.TableDefs("nomDeTaTable").Fields.Append champs

Regarde la méthode CreateField dans VB et la propriété name pour tester
l'existence de ton champs dans ta table.

"Pat" a écrit dans le message de news:
437ee69e$0$2144$

Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient:: CurrentDb.Execute
"ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas
la syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------











--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr



Avatar
Pat
Non, j'ai vérifié cette référence est cochée.

Merci tout de même, c'est pas facile de créer des champs dans des tables
attachées.;-)) quand on est pas doué comme moi.

Pat

"Eric" a écrit dans le message de news:

Bonjour,
Serait-ce Microsoft DAO 3.x Object Library qu'il te faut ?

Merci pour ces infos mais j'ai le message variable non définie, je
suppose qu'il manque une référence mais laquelle?

Je n'ai pas la doc de VB, comment tester si le champ existe.

Merci pour ton aide.

Pat

"Giorgio_AP" <David47(arrobas)Caramail(point)com> a écrit dans le message
de news:

La création d'un champs peut se faire par le code suivant:
Set champs = CurrentDb.TableDefs!nomDeTaTable.CreateField ("nomduchamps",
dbtext, 50)
CurrentDb.TableDefs("nomDeTaTable").Fields.Append champs

Regarde la méthode CreateField dans VB et la propriété name pour tester
l'existence de ton champs dans ta table.

"Pat" a écrit dans le message de news:
437ee69e$0$2144$

Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient::
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas
la syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------











--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr





Avatar
Raymond [mvp]
Bonjour.

depuis quand peut-on modifier la structure d'une base attachée ? c'est
nouveau, ça vient de sortir.
voir aide en ligne.

--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://www.mpfa.info/ pour débuter sur le forum


"Pat" a écrit dans le message de news:
437f4817$0$8923$
Non, j'ai vérifié cette référence est cochée.

Merci tout de même, c'est pas facile de créer des champs dans des tables
attachées.;-)) quand on est pas doué comme moi.

Pat

"Eric" a écrit dans le message de news:

Bonjour,
Serait-ce Microsoft DAO 3.x Object Library qu'il te faut ?

Merci pour ces infos mais j'ai le message variable non définie, je
suppose qu'il manque une référence mais laquelle?

Je n'ai pas la doc de VB, comment tester si le champ existe.

Merci pour ton aide.

Pat

"Giorgio_AP" <David47(arrobas)Caramail(point)com> a écrit dans le
message de news:

La création d'un champs peut se faire par le code suivant:
Set champs = CurrentDb.TableDefs!nomDeTaTable.CreateField
("nomduchamps", dbtext, 50)
CurrentDb.TableDefs("nomDeTaTable").Fields.Append champs

Regarde la méthode CreateField dans VB et la propriété name pour tester
l'existence de ton champs dans ta table.

"Pat" a écrit dans le message de news:
437ee69e$0$2144$

Bonjour,

Je cherche un code VBA qui, à l'ouverture d'un formulaire, vérifie
l'existance de plusieurs champs dans une table et qui les ajoute s'ils
n'existent pas.

Pour créer un champs Texte je pense que ceci convient::
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CHAR(50) " ; "

Mais je dois également créer des champs suivants dont je ne connais pas
la syntaxe:

- Numérique - Réel simple -Décimales 2
- Numérique - Réel simple - Décimales Auto
- Vrai/faux

De plus je ne connaîs pas le code pour vérifier l'existance des champs

Ci-dessous une ébauche de code mais qui ne fonctionne pas.

Merci pour votre aide précieuse.

Pat (au soleil ce matin)

-------------------------------------
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err

If CurrentDb.QueryDefs.Fields("TbleA").Name.Exist = "Champ1" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ1 CURRENCY ; "
End If
If CurrentDb.QueryDefs.Fields("TbleA").Name = "Champ2" Then
CurrentDb.Execute "ALTER TABLE TbleA ADD COLUMN Champ2 CHAR(50) " ; "
End If

Form_Open_Exit:
Exit Sub

Form_Open_Err:
MsgBox error$
Resume Form_Open_Exit

End Sub
--------------------------------------------











--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr









Avatar
Eric
Bonsoir Raymond,

C'est ce que je pensais mais on peut effectivement modifier la structure
d'une table attachée par exemple en lui ajoutant des champs, du moins en
local puisque je n'ai pas de reseau, via une procédure DAO et non par
une exécution de SQL -Définition des données.


Bonjour.

depuis quand peut-on modifier la structure d'une base attachée ? c'est
nouveau, ça vient de sortir.
voir aide en ligne.



--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr

Avatar
Eric
re,

Voila un bout de code simplifié qui devrait fonctionner, la table dans
laquelle tu ajoutes le(s) champ(s) est figée. Tu devras modifier la
ligne set t½.TableDefs("NomTable") ou tu ajoutes un argument à la
procédure pour lui passer le nom de la table.

Sub AjoutChamp(strNomChamp As String, intTypeChamp As Integer, Optional
Longueur As Integer = 50)
Dim t As DAO.TableDef, w As DAO.Workspace, bd As DAO.Database,
Trouve As Boolean
Set w = DBEngine.Workspaces(0)
Set bd = w.OpenDatabase("LeCheminLaBase.mdb")
Set t = bd.TableDefs("NomTable")
Dim f As DAO.Field
For Each f In t.Fields
If LCase(f.Name) = LCase(strNomChamp) Then
Trouve = True
Exit For
End If
Next
If Not Trouve Then
With t
Set f = .CreateField(strNomChamp , intTypeChamp)
If intTypeChamp= dbText Then
f.Size = Longueur
End If
.Fields.Append f
End With
End If
bd.Close
w.Close
Set f = Nothing
Set t = Nothing
Set bd = Nothing
Set w = Nothing
End Sub

Non, j'ai vérifié cette référence est cochée.

Merci tout de même, c'est pas facile de créer des champs dans des tables
attachées.;-)) quand on est pas doué comme moi.

Pat




--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr

Avatar
Eric
.../...
et tu la lances par :
AjoutChamp "unTexte", dbText
ou
AjoutChamp "UnNumérique", dbSingle


--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr
1 2