Gestion des fichiers sequentiels
Description
Bonjour à tous,
Voici mon deuxième code sur le site. Il permet la gestion de fichiers séquentiel.
La gestion comprend :
- la création du fichier.
- l'ouverture de celui-ci lorsqu'il existe.
- l'ajout de données dans le fichier.
- la suppresion d'un enregistrement dans le fichier.
- la recherche d'un enregistrement sur le nom (implémente le fait d'entrer que les première lettre)
- la modification d'un enregistrement.
- et la possibilité de voiyager dans les enregistrements grâce aux boutons : premier, précédent, suivant et dernier.
Un test sur l'objet CommonDialogPrint est mis mais ne fonctionne pas c'était pour voir ce que ça donné.
Il existe surement quelques bugs car je ne l'ai pas fini à fond au niveau de la gestion des erreurs.
Le code est un peu commenté si j'en ai le temps, j'ajouterai plus tard une mise à jour avec le plus de commentraires possible.
Si vous avez des suggetions ou questions, n'hésitez pas je ferais mon possible pour y répondre.
J'allais oublier, j'utilise quelques procédures donc bien faire attention ;-)
Bonne prog à tous J-il
Voici mon deuxième code sur le site. Il permet la gestion de fichiers séquentiel.
La gestion comprend :
- la création du fichier.
- l'ouverture de celui-ci lorsqu'il existe.
- l'ajout de données dans le fichier.
- la suppresion d'un enregistrement dans le fichier.
- la recherche d'un enregistrement sur le nom (implémente le fait d'entrer que les première lettre)
- la modification d'un enregistrement.
- et la possibilité de voiyager dans les enregistrements grâce aux boutons : premier, précédent, suivant et dernier.
Un test sur l'objet CommonDialogPrint est mis mais ne fonctionne pas c'était pour voir ce que ça donné.
Il existe surement quelques bugs car je ne l'ai pas fini à fond au niveau de la gestion des erreurs.
Le code est un peu commenté si j'en ai le temps, j'ajouterai plus tard une mise à jour avec le plus de commentraires possible.
Si vous avez des suggetions ou questions, n'hésitez pas je ferais mon possible pour y répondre.
J'allais oublier, j'utilise quelques procédures donc bien faire attention ;-)
Bonne prog à tous J-il
Source / Exemple :
Option Explicit
Dim str_nom_fichier As String
Dim str_nom As String
Dim str_prenom As String
Dim int_salaire As Integer
Dim var_tableau_saisie() As Variant 'type variant car on a des données caractère et numérique
Dim int_pointeur_record As Integer
Public Function FONCTION_CHEMIN(str_nom_fichier As String) As String 'str_nom_fichier est le paramètre de la fonction et cela
'ce fait comme pour la déclaration de la variable sauf qu'on
'a pas le dim
'la fct est constitué d'une variable local de type string et elle reçoit l'App.path
'pour savoir si il y a un back slash à la fin je dois tester de dernier caractère de ma chaine
'et si c'est vrai, on rajoute un back slash
Dim str_chemin As String
str_chemin = App.Path
'le 1 signifie je prend le premier caractère à partir de la droite à la fin de la chaine
If Right(str_chemin, 1) <> "\" Then str_chemin = str_chemin + "\" '-> ajout du back slash
FONCTION_CHEMIN = str_chemin + str_nom_fichier
End Function
Private Sub bou_dernier_Click()
int_pointeur_record = FONCTION_NOMBRE_RECORDS
Call PROCEDURE_REMPLIR_BOITES_TEXTES
End Sub
Private Sub bou_fermer_exe_Click()
List1.Visible = False
List1.Clear
End Sub
Private Sub bou_modifier_Click()
Call PROCEDURE_REMPLIR_TABLEAU
Call PROCEDURE_ECRIRE_DANS_TABLEAU
End Sub
Private Sub bou_precedent_Click()
int_pointeur_record = int_pointeur_record - 1
If int_pointeur_record < 1 Then
MsgBox "DEBUT DE FICHIER ....", vbOKOnly + vbInformation
Else
Call PROCEDURE_REMPLIR_BOITES_TEXTES
End If
End Sub
Private Sub bou_rechercher_Click()
Dim int_i As Integer
Dim int_drapeau As Integer
Dim str_recherche As String
Dim int_longueur_recherche As Integer
str_recherche = InputBox("Entrez le nom de la personne à rechercher")
int_longueur_recherche = Len(str_recherche)
If str_recherche = "" Then Exit Sub
For int_i = 1 To FONCTION_NOMBRE_RECORDS
If Left(var_tableau_saisie(int_i, 1), int_longueur_recherche) = UCase(str_recherche) Then
int_pointeur_record = int_i - 1
int_drapeau = 1
Call bou_suivant_Click
Exit Sub
End If
Next int_i
If int_drapeau = 0 Then
MsgBox "Cette personne n'est pas dans votre fichier .....", vbOKOnly + vbInformation
End If
End Sub
Private Sub bou_suivant_Click()
int_pointeur_record = int_pointeur_record + 1
If int_pointeur_record > FONCTION_NOMBRE_RECORDS Then
MsgBox "FIN DE FICHIER ....", vbOKOnly + vbInformation
Else
Call PROCEDURE_REMPLIR_BOITES_TEXTES
End If
End Sub
Private Sub bou_supprimer_Click()
Dim int_reponse As Integer
'MsgBox pour demander à l'utilisateur s'il est sûr de vouloir supprimer
int_reponse = MsgBox("Etes-vous certain de vouloir supprimer ?" _
, vbYesNo + vbCritical)
If int_reponse = vbNo Then
Exit Sub
Else
'Test pour savoir si le fichier contient un seul enregistrement is oui il supprimer simplement
'car pas besoin de réinscrire les autres données.
If FONCTION_NOMBRE_RECORDS = 1 Then
MsgBox "Le fichier contient un enregistrement !"
Open FONCTION_CHEMIN("FICHIER1.SEQ") For Output As #1
Exit Sub
End If
Open FONCTION_CHEMIN("FICHIER1.SEQ") For Input As #1 'ouvre le fichier en lecture
Open FONCTION_CHEMIN("TEMPO.SEQ") For Append As #2 'ouvre le fichier en écriture
Do While Not EOF(1)
Input #1, str_nom, str_prenom, int_salaire
If str_nom <> txt_nom.Text Then
Write #2, str_nom, str_prenom, int_salaire
End If
Loop
Close
End If
Kill FONCTION_CHEMIN("FICHIER1.SEQ")
Name FONCTION_CHEMIN("TEMPO.SEQ") As FONCTION_CHEMIN(str_nom_fichier)
Call PROCEDURE_MISE_A_JOUR
Call bt_premier_Click
End Sub
Private Sub bt_ajout_Click()
bt_valider_ajout.Enabled = True
bt_ajout.Enabled = False
bou_dernier.Enabled = False
bou_modifier.Enabled = False
bou_precedent.Enabled = False
bou_rechercher.Enabled = False
bou_suivant.Enabled = False
bou_supprimer.Enabled = False
bt_premier.Enabled = False
Call PROCEDURE_EFFACER_BOITES_DE_TEXTE
End Sub
Private Sub bt_creation_Click()
On Error GoTo erreur 'gestion des erreurs
Dim int_reponse As Integer
str_nom_fichier = InputBox("Entrez le nom du fichier .") 'on utilise l'inputbox pour entrer le nom du fichier à créer
If str_nom_fichier = "" Then Exit Sub 'test si le nom de fichier dans l'inputbox est vide si oui, il quitte et n'ajoute pas lorsqu'on fait annuler
str_nom_fichier = UCase(str_nom_fichier + ".seq") 'ajout au nom de fichier une extension en faisant une concaténation
'et Ucase pour la recherche comme ça tout esst en majuscule
'test si fichier existe déjà
'MsgBox FONCTION_CHEMIN(str_nom_fichier)
'MsgBox str_nom_fichier
'MsgBox Dir(FONCTION_CHEMIN(str_nom_fichier)) & " " & str_nom_fichier
If Dir(FONCTION_CHEMIN(str_nom_fichier)) = str_nom_fichier Then 'test si le fichier existe sur le disque ou pas grace à Dir
'utilisation de la MsgBox comme une fonction, ce qui se passe dans la MsgBox passe dans la variable
int_reponse = MsgBox("Attention le fichier " & str_nom_fichier & " existe ...." & Chr(13) _
& "Voulez-vous le supprimer ? ", vbInformation + vbYesNo)
If int_reponse = vbNo Then 'si je ne veux pas le recréer alors je sors
Exit Sub
Else
'sinon je le recrée
Open FONCTION_CHEMIN(str_nom_fichier) For Output As #1
Close
End If
Else
'si je suis ici c'est que le fichier n'existe pas et qu'on a pas besoin de demander si on veut le recréer
Open FONCTION_CHEMIN(str_nom_fichier) For Output As #1
Close 1
End If
Exit Sub '
erreur: 'Gestion des erreurs
Call GESTION_DES_ERREURS '
End Sub
Private Sub bt_exercice_Click()
List1.Visible = True
List1.AddItem "AJOUTER LES BOUTONS : SUIVANT, PRECEDENT,DERNIER"
List1.AddItem "PROGRAMMER CEUX-CI"
List1.AddItem "INTERDIRE A L'UTILISATEUR D'ENTRER DES CHIFFRES POUR LE NOM ET LE PRENOM"
List1.AddItem "INTERDIRE A L'UTILISATEUR D'ENTRER DES LETTRES POUR LE SALAIRE"
List1.AddItem "FORCER LES MAJUSCULES"
List1.AddItem "INHIBER LES BOUTONS ADEQUATS"
List1.AddItem "MODIFIER LES POLICES"
End Sub
Private Sub bt_ouvrir_Click()
Dim int_reponse As Integer
str_nom_fichier = InputBox("Entrez le nom du fichier .")
str_nom_fichier = Trim(UCase(str_nom_fichier + ".seq"))
MsgBox Dir(FONCTION_CHEMIN(str_nom_fichier)) & " " & str_nom_fichier
MsgBox Len(UCase(Dir(FONCTION_CHEMIN(str_nom_fichier)))) & " " & Len(str_nom_fichier)
If Dir(FONCTION_CHEMIN(str_nom_fichier)) <> str_nom_fichier Then
int_reponse = MsgBox("Attention le fichier " & str_nom_fichier & " n'existe pas" & Chr(13) _
& "Voulez-vous le créer ? ", vbInformation + vbYesNo)
If int_reponse = vbYes Then
'création du fichier
Open FONCTION_CHEMIN(str_nom_fichier) For Output As #1
Close
Else
'quitte car on clique sur le bouton non donc je sors
Exit Sub
End If
Else
'Est-elle vide ?
If FONCTION_NOMBRE_RECORDS = 0 Then
MsgBox "Votre fichier est vide .....", vbInformation + vbOKOnly
Else
Open FONCTION_CHEMIN(str_nom_fichier) For Input As #1
bou_dernier.Enabled = True
bou_modifier.Enabled = True
bou_precedent.Enabled = True
bou_rechercher.Enabled = True
bou_suivant.Enabled = True
bou_supprimer.Enabled = True
bt_ajout.Enabled = True
bt_premier.Enabled = True
bt_creation.Enabled = False
bt_ouvrir.Enabled = False
Close
Call PROCEDURE_MISE_A_JOUR
Call bt_premier_Click 'appel d'une procédure événementielle, se met sur le premier enregistrement lorsque j'ouvre la bdd
End If
End If
End Sub
Public Function FONCTION_NOMBRE_RECORDS()
Dim int_compteur_records As Integer
Open FONCTION_CHEMIN(str_nom_fichier) For Input As #1
Do While Not EOF(1)
Input #1, str_nom, str_prenom, int_salaire 'elles sont déclarée de manière générale car on les utilisent bcp
int_compteur_records = int_compteur_records + 1
Loop
Close 'ferme le fichier
FONCTION_NOMBRE_RECORDS = int_compteur_records
End Function
Public Sub PROCEDURE_EFFACER_BOITES_DE_TEXTE()
txt_nom = ""
txt_prenom = ""
txt_salaire = ""
txt_nom.SetFocus
End Sub
Private Sub bt_premier_Click()
int_pointeur_record = 1
Call PROCEDURE_REMPLIR_BOITES_TEXTES
End Sub
Private Sub bt_valider_ajout_Click()
'affectation des variables au boîtes de texte
str_nom = txt_nom.Text
str_prenom = txt_prenom.Text
int_salaire = Val(txt_salaire.Text) 'transforme les caractère en valeur numérique
Open FONCTION_CHEMIN(str_nom_fichier) For Append As #1 'j'ouvre le fichier en écriture
Write #1, str_nom, str_prenom, int_salaire
Close 1 'ferme le fichier
bt_valider_ajout.Enabled = False
bt_ajout.Enabled = True
bou_dernier.Enabled = True
bou_modifier.Enabled = True
bou_precedent.Enabled = True
bou_rechercher.Enabled = True
bou_suivant.Enabled = True
bou_supprimer.Enabled = True
bt_premier.Enabled = True
Call PROCEDURE_MISE_A_JOUR
End Sub
Public Sub PROCEDURE_MISE_A_JOUR()
Dim int_compteur_records As Integer 'même nom de variable que dans la fonction NOMBRE RECORDS
'MsgBox FONCTION_NOMBRE_RECORDS 'affiche le nbr de records
ReDim var_tableau_saisie(1 To FONCTION_NOMBRE_RECORDS, 3) 'on redimensionne un tableau par rapport au nbr de record dans la
'première dimension du tableau à deux dimension et la deuxième dimension est
'3 car j'ai un nom, un prénom et un salaire.
Open FONCTION_CHEMIN(str_nom_fichier) For Input As #1 'ouverture en lecture
Do While Not EOF(1)
int_compteur_records = int_compteur_records + 1 'on incrémente tout de suite i pour avoir la valeurr de 1 et pas zéro sinon elle ne sera pas sur le premier enregistrement
Input #1, str_nom, str_prenom, int_salaire 'lecture du premier enregistre qu'on met dans le tableau
var_tableau_saisie(int_compteur_records, 1) = str_nom 'mise du nom dans le tableau
var_tableau_saisie(int_compteur_records, 2) = str_prenom 'mise du prénom dans le tableau
var_tableau_saisie(int_compteur_records, 3) = int_salaire 'mise du salaire dans le tableau
Loop
Close 1 'fermeture du fichier
End Sub
Public Sub PROCEDURE_REMPLIR_BOITES_TEXTES()
txt_nom.Text = var_tableau_saisie(int_pointeur_record, 1) 'affecte le premier élément du tableau à la boite de texte nom
txt_prenom.Text = var_tableau_saisie(int_pointeur_record, 2)
txt_salaire = var_tableau_saisie(int_pointeur_record, 3)
End Sub
Private Sub Command1_Click()
CommonDialog1.ShowPrinter
End Sub
Private Sub Form_Load()
Form1.Show
List1.Visible = False
bou_dernier.Enabled = False
bou_modifier.Enabled = False
bou_precedent.Enabled = False
bou_rechercher.Enabled = False
bou_suivant.Enabled = False
bou_supprimer.Enabled = False
bt_ajout.Enabled = False
bt_premier.Enabled = False
bt_valider_ajout.Enabled = False
End Sub
Public Sub GESTION_DES_ERREURS()
MsgBox "L'erreur suivante s'est produite : " & Err.Description, vbInformation + vbOKOnly, "Erreur"
End Sub
Private Sub txt_nom_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
'Filtre pour les erreurs éventuelles d'encodage
If InStr("AZERTYUIOPQSDFGHJKLMWXCVBNazertyuiopmlkjhgfdsqwxcvbnéèàçêöëïä-" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Private Sub txt_prenom_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Public Sub PROCEDURE_ACTIVATION_DES_BOUTONS()
bt_ajout.Enabled = False
bt_valider_ajout.Enabled = False
bt_premier.Enabled = False
End Sub
Public Sub PROCEDURE_REMPLIR_TABLEAU()
'Ecriture du record modifié dans le tableau
var_tableau_saisie(int_pointeur_record, 1) = txt_nom.Text
var_tableau_saisie(int_pointeur_record, 2) = txt_prenom.Text
var_tableau_saisie(int_pointeur_record, 3) = txt_salaire.Text
End Sub
Public Sub PROCEDURE_ECRIRE_DANS_TABLEAU()
Dim int_i As Integer
Dim int_j As Integer
Dim int_tempo_nbr_records As Integer
int_tempo_nbr_records = FONCTION_NOMBRE_RECORDS
Open FONCTION_CHEMIN("FICHIER1.SEQ") For Output As #1
For int_i = 1 To int_tempo_nbr_records
Write #1, var_tableau_saisie(int_i, 1), var_tableau_saisie(int_i, 2), var_tableau_saisie(int_i, 3)
Next int_i
Close
End Sub
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.