Soyez le premier à donner votre avis sur cette source.
Vue 9 226 fois - Téléchargée 820 fois
Option Explicit Sub Test_Creer_Toute_Table() Call Creer_Toute_Table(strNomTable:="MaNouvelleTable") End Sub ' Crée une table avec un nombre divers de champs Function Creer_Toute_Table(strNomTable As String) As Boolean On Error GoTo TrappeErreur Dim strNomChamp As String Dim intTypeChamp As Integer Dim tblNouvelleTable As DAO.TableDef Dim fldNouveauChamp As DAO.Field With CurrentDb ' Vérifie si une table du même nom existe déjà If VerifierExistenceTable(strNomTable:=strNomTable) = True Then If MsgBox(Prompt:="Une table nommée " & vbCrLf & _ strNomTable & vbCrLf & _ "existe déjà. Désirez-vous continuer et remplacer celle-ci ?", _ Buttons:=vbCritical + vbYesNo, _ Title:="Table existe déjà") = vbNo Then GoTo ExitHere Else ' Supprime la table existante DoCmd.DeleteObject ObjectType:=acTable, _ ObjectName:=strNomTable End If End If ' Crée la table Set tblNouvelleTable = .CreateTableDef(strNomTable) Definir_Champ: With tblNouvelleTable strNomChamp = InputBox(Prompt:="Nom du champ", _ Title:="Saisir") ' Sort de la fonction s'il aucun nom n'a été fournit If strNomChamp = vbNullString Then GoTo ExitHere End If On Error Resume Next intTypeChamp = InputBox(Prompt:="Nombre correspondant au type de champ;" & vbCrLf & _ " Booléen = 1" & vbCrLf & _ " Octet = 2" & vbCrLf & _ " Entier = 3" & vbCrLf & _ " Long = 4" & vbCrLf & _ " Monétaire = 5" & vbCrLf & _ " Réel simple = 6" & vbCrLf & _ " Réel double = 7" & vbCrLf & _ " Date / heure = 8" & vbCrLf & _ " Binaire = 9" & vbCrLf & _ " Texte = 10" & vbCrLf & _ " Objet Ole = 11" & vbCrLf & _ " Mémo = 12", _ Title:="Type de champ", _ Default:=10) ' Sort de la fonction si l'inputBox a été annulée If Err.Number = 13 Then GoTo ExitHere End If ' Crée le champ Set fldNouveauChamp = .CreateField(Name:=strNomChamp, _ Type:=intTypeChamp) ' Ajoute le champ à la collection Fields .Fields.Append fldNouveauChamp End With ' Vérifie si l'usager désire ajouter un autre champ If MsgBox(Prompt:="Désirez-vous ajouter un autre champ ?", _ Buttons:=vbQuestion + vbYesNo, _ Title:="Nouveau champ") = vbYes Then GoTo Definir_Champ End If ' Ajoute la table à la collection TableDefs .TableDefs.Append tblNouvelleTable End With Sortie: Set fldNouveauChamp = Nothing Set tblNouvelleTable = Nothing Exit Function TrappeErreur: MsgBox Err.Description Resume Sortie End Function ' Verifie si une table existe dans la base de données courante Function VerifierExistenceTable(strNomTable As String) As Boolean Dim tblTable As DAO.TableDef VerifierExistenceTable = False For Each tblTable In CurrentDb.TableDefs If tblTable.Name = strNomTable Then VerifierExistenceTable = True Exit For End If Next End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.