Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 589 fois - Téléchargée 44 fois
'Ces fonctions sont à mettre ds les déclaration de la Form. 'Fonction de test d'éxistance d'un fichier ' Public Function FichierExiste(ByVal Nom As String) As Boolean On Error Resume Next Dim attrib As Integer attrib = GetAttr(Nom) 'Renvoie un nombre qui représente les attributs d'un fichier ou d'un répertoire. If (Err <> 0) Then 'Contient des informations concernant les erreurs d'exécution. FichierExiste = False Else If ((attrib And vbDirectory) = vbDirectory) Then FichierExiste = False Else FichierExiste = True End If End If End Function Private Sub creationBDD(rien) 'test si la BDD éxiste déja If (FichierExiste("c:\divers.mdb")) Then machaine = "vide" Else ' Crée une base de données codée si elle n'existe pas encore. Set db = DefaultWorkspace.CreateDatabase("c:\divers.MDB", dbLangGeneral) ' Remplit la nouvelle base de données. sql = "CREATE TABLE divers (num COUNTER,nom TEXT (55),prenom TEXT(55),age TEXT (55),datehoraire DATETIME,warning TEXT(55))" 'on met les champs qu'on veut !! db.Execute sql '(5)= Le nombre de caractère MAX dans le champ (Pour TEXT uniquement) 'TEXT = Le type de donnés 'La table recepteur Est crée db.Close End If End Sub Private Sub ajoutBDD(rien) 'écriture des données dans des bases de données 'écriture des données dans la base de données historique Set db = OpenDatabase("c:\divers.mdb") 'ouverture de la base sql = "SELECT * FROM divers" ' On séléctionne tous les champs de la table alldata Set rs = db.OpenRecordset(sql, dbOpenDynaset) ' ici on est bien en mode écriture dbOpenDynaset Do While Not rs.EOF 'BOUCLE Tant Que" 'test de l'éxistance des champs renseigné If rs.Fields("nom") = Text1.Text Then Or rs.Fields("prenom") = Text2.Text Or rs.Fields("age") = Text3.Text Or rs.Fields("warning") = Text4.Text Then 'si le champ saisi par l'utilisateur existe déja met la variable "meme" est mis à 1 meme = 1 'sort de la boucle Exit Do End If rs.MoveNext 'ensuite on passe à l'enregistrement suivant qui se trouve dans notre Recordset Loop ' Fin de la boucle Tant que 'si la var "meme" est à 1, affichage du message "le nom ... existe ..." If meme = 1 Then Msg = "Un, ou plusieurs, champ(s) renseigné(s) existe(nt) déja! Veuillez le(s) changer." ' Définit le message. Style = vbOKOnly + vbQuestion + vbDefaultButton1 ' Définit les boutons. Titre = "Erreur" ' Définit les titres. Aide = "DEMO.HLP" ' Définit le fichier d'aide. Contexte = 1000 ' Définit le contexte de la rubrique. ' Affiche le message. Réponse = MsgBox(Msg, Style, Titre, Aide, Contexte) If Réponse = vbOK Then ' L'utilisateur a choisi le bouton " Oui ". End If End If 'si la var "meme" n'est pas à 1 alors la BDD est mise à jours If meme <> 1 Then rs.AddNew ' on va ajouter un enregistrement à notre recordset rs.Fields("nom") = Text1.Text 'ajoute le champ contenu ds la zone de texte 1 rs.Fields("prenom") = Text2.Text 'ajoute le champ contenu ds la zone de texte 2 rs.Fields("age") = Text3.Text 'ajoute le champ contenu ds la zone de texte 3 rs.Fields("warning") = Text4.Text 'ajoute le champ contenu ds la zone de texte 4 rs.Update 'Une fois les valeurs définies, on met à jour notre Recordset End If rs.Close 'ferme la table End Sub Private Sub Command1_Click() Msg = "Vous allez ajouter un nouveau badge, voulez vous continuez ?" ' Définit le message. Style = vbYesNoCancel + vbQuestion + vbDefaultButton1 ' Définit les boutons. Titre = "quitter?" ' Définit les titres. Aide = "DEMO.HLP" ' Définit le fichier d'aide. Contexte = 1000 ' Définit le contexte de la rubrique. ' Affiche le message. Réponse = MsgBox(Msg, Style, Titre, Aide, Contexte) If Réponse = vbYes Then ' L'utilisateur a choisi le bouton " Oui ". Call ajoutBDD(rien) End If If Réponse = vbNo Then ' L'utilisateur a choisi le bouton " Non ". MaChaîne = "Non" ' Accomplit une action. End If If Réponse = vbCancel Then MaChaîne = "Annuler" End IfEnd sub Private Sub Form_Load() Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" call creationBDD(rien) End sub
13 nov. 2005 à 18:02
Je télécharge et je vais étudier ça au calme.
Merci et à bientôt !
23 juil. 2002 à 11:58
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.