Gestion des fichiers sequentiels

Soyez le premier à donner votre avis sur cette source.

Vue 7 913 fois - Téléchargée 1 269 fois

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

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

Codes Sources

A voir également

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.