begin process at 2012 02 12 16:20:23
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > CRÉATION ASSISTÉE PAR CODE DAO D’UNE TABLE DANS MS ACCESS – NOMBRE ET TYPE DE CHAMPS SELON LES BESOINS.

CRÉATION ASSISTÉE PAR CODE DAO D’UNE TABLE DANS MS ACCESS – NOMBRE ET TYPE DE CHAMPS SELON LES BESOINS.


 Information sur la source

Note :
Aucune note
Catégorie :VBA Classé sous :access, dao, tabledef, fields, vba Niveau :Initié Date de création :20/07/2007 Vu / téléchargé :7 315 / 698

Auteur : hector_quebec

Ecrire un message privé
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note


 Description

Voici 2 fonctions pour créer une nouvelle table dans MS Access par code DAO et vérifier s’il n’existe pas déjà dans la base de données une table du même nom.

Voici les étapes de la fonction Creer_Toute_Table :

o vérifie si la table existe déjà et, si elle existe, que l’usager est d’accord pour la remplacer sinon on sort de la fontion
o demande le nom du champ à créer et si aucun nom n’est fournit, on sort de la fonction
o demande le type de champs (choix de 12 types) et sort de la fonction si l’usager annule cette étape
o crée le champ et l’ajoute à la collection Fields
o vérifie si l’usager désire ajouter un autre champ et recommence si oui  et, si non, ajoute la table à la collection TableDefs et termine.
  
L’appel de la fonction se fait ainsi;

Call Creer_Toute_Table(strNomTable:="MaNouvelleTable")

Source

  • 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
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


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
  • Creation_Table.mdbTélécharger ce fichier [Réservé aux membres club]147 456 octets

Télécharger le zip


 Sources du même auteur

Source avec Zip FONCTION DAO PERMETTANT DE VÉRIFIER SI UNE TABLE POSSÈDE UN ...
Source avec Zip UTILISATION D’UNE COLLECTION POUR GÉRER TOUS LES PARAMÈTRES ...
Source avec Zip REQUÊTE SQL UNION DE MS ACCESS ERRONÉE SANS LE PRÉDICAT ALL.

 Sources de la même categorie

Source avec Zip GESTION PERSONNEL par oudlarbi
Source avec Zip Source avec une capture CALENDRIER EN VBA POUR EXCEL 2010 par nounou94
Source avec Zip Source avec une capture MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai
Source avec Zip Source avec une capture COLLECTION ID par Le Pivert
Source avec Zip Source avec une capture VBA MASQUE DE SAISIE NUMÉRIQUE par acive

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture Source .NET (Dotnet) EPHEMERIDE_VB.NET par Le Pivert
Source avec Zip OUTIL DE FORMATION par l0r3nz1
Source avec Zip GEOLOCALISATION WGS84 par l0r3nz1
Source avec Zip Source avec une capture MDB TO BAS par skyla
Source avec Zip FONCTION DAO PERMETTANT DE VÉRIFIER SI UNE TABLE POSSÈDE UN ... par hector_quebec

Commentaires et avis

Aucun commentaire pour le moment.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

[ACCESS VBA] DEFINIR LES PROPRIETES des champs suivants EN CODE VBA ACCESS [ par jasmin_sauvage ] Bonsoir à tous,J'ai un problème très urgent :Je veux créer une table (Matable) dans laquelle il y a plusieurs champs (Heure,NGH, T [Déplacé VB6 --> VBA] suppression doublons tabel access sous vba [ par dacarolin ] bonjour j ai un message erreur execution 3141 dans l instruction select que je n arrive pas a corriger dans cette ligne de code ci dessous qc peut il besoin d'une intiation de projet menné par access VBA. [ par mecasargoule ] je mène un projet de fin d'etude, je dois faire une base de données VBA access,pour afficher les indicateur de performance de sté, je n'ai pas une idé Listview access vba [ par mickael692 ] Bonjour à tous, Etudiant et débutant en VBA, je développe depuis quelques temps sous VBA, dans le cadre de ma scolarité, un utilitaire sous Access per developpement sous vba access sites [ par georgeskoly ] je demande des exemples de projets pour la gestion d'une pharmacie en programmant sous vba access ou des sites programmation sous vba access vba excel access, attente entre les ordres [ par ls8ls8 ] Bonjour à tous, Une macro excel sollicite plusieurs fois une base access (écriture et récupérations de données, lancement de macro access avec shell, barre de progression VBA access [ par vbaddict44 ] bonjour, j'aimerai intégrer une barre de progression qui affiche l'état d'avancement (en pourcentage ou en seconde) de mon programme vba déclenché p [Déplacé encore et encore et encore de .Net --> VBA] code VBA du bouton modifier sous access [ par hirondellle ] tout d'abord bonjour tout le monde. alors permettez moi de vous expliquer ma qustion, j'ai un formulaire access avec un bouton Modifier, je veux lor DAO creation de table [ par vbaddict44 ] Bonjour, je souhaite créer une table Access a l'aide de DAO. il n'y a pas de souci la table est bien créer mais le problème intervient quand je veux [Catégorie modifiée .Net --> VBA] Gestion des groupes de raccourcis via VBA sous Access 2003 [ par LargoWinch38 ] Bonjour, savez-vous s'il est possible de gérer les groupes de favoris via du code VBA ? Je parle des raccourcis qu'il est possible d'ajouter à un "Gr


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,420 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales