CRÉATION D'ÉTIQUETTES VB6 / CRYSTAL REPORT

Option Explicit
'Déclaration de variables de manière général afin qu'elles soient connue de tout le programme
Dim ws As Workspace                   'variable pour l'espace de travail
Dim ma_bdd As Database              'variable pour la base de données
Dim rst As Recordset                    'variable pour le RecordSet
Dim str_nom As String                  'variable pour recueillir le nom
Dim str_prenom As String             'variable pour recueillir le prénom

Private Sub bou_annuler_ajout_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration de la variable pour la MsgBox
Dim int_reponse As Integer

        int_reponse = MsgBox("Etes-vous sûr de vouloir annuler l'ajout d'un contact ?", vbYesNo + vbExclamation, "Annuler")
    
        If int_reponse = vbYes Then
    
            'Passage de la propriété Enabled à True pour réactiver certains boutons
            bou_liste_contact.Enabled = True
            bou_supprimer_contact.Enabled = True
 
            'Passage de la propriété Visible à False pour masquer certains objets
            frame_ajout_donnee.Visible = False
            
            'Effacement des boîtes de textes pour ne pas avoir de texte lorsque l'on revient dans cette section
            txt_ajout_nom.Text = ""
            txt_ajout_prenom.Text = ""
            txt_ajout_adresse.Text = ""
            txt_ajout_localite.Text = ""
            txt_ajout_code_postal.Text = ""
            
           End If

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton annuler ajout d'un contact.")
    
End Sub

Private Sub bou_enregister_ajout_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration de la variable pour la MsgBox
Dim int_reponse As Integer

Set ws = DBEngine.Workspaces(0)                                                      'ouverture de l'espace de travail
Set ma_bdd = ws.OpenDatabase(bdd_etiquettes.DatabaseName)           'ouverture de la base de données
Set rst = ma_bdd.OpenRecordset("DONNEES")                                  'ouverture du RecordSet

        'Tests afin de vérifier les champs non remplis car tous les champs doivent être rempli
        'test de la boîte de texte nom
        If txt_ajout_nom.Text = "" Then
        
            MsgBox "Veuillez remplir le champ nom s'il vous plaît !", , "Vide"
            txt_ajout_nom.SetFocus 'remise du Setfocus sur la boites de texte pour faciliter l'encodage
            Exit Sub                       'Exit Sub pour sortir du bouton afin qu'il nenregistre pas le contact et que l'on puisse ajouter les données
        
        End If
        'test de la boîte de texte prénom
        If txt_ajout_prenom.Text = "" Then
        
            MsgBox "Veuillez remplir le champ prénom s'il vous plaît !", , "Vide"
            txt_ajout_prenom.SetFocus 'remise du Setfocus sur la boites de texte pour faciliter l'encodage
            Exit Sub                            'Exit Sub pour sortir du bouton afin qu'il nenregistre pas le contact et que l'on puisse ajouter les données
        
        End If
        'test de la boîte de texte adresse
        If txt_ajout_adresse.Text = "" Then
        
            MsgBox "Veuillez remplir le champ adresse s'il vous plaît !", , "Vide"
            txt_ajout_adresse.SetFocus 'remise du Setfocus sur la boites de texte pour faciliter l'encodage
            Exit Sub                            'Exit Sub pour sortir du bouton afin qu'il nenregistre pas le contact et que l'on puisse ajouter les données
        
        End If
        'test de la boîte de texte localité
        If txt_ajout_localite.Text = "" Then
        
            MsgBox "Veuillez remplir le champ localité s'il vous plaît !", , "Vide"
            txt_ajout_localite.SetFocus 'remise du Setfocus sur la boites de texte pour faciliter l'encodage
            Exit Sub                            'Exit Sub pour sortir du bouton afin qu'il nenregistre pas le contact et que l'on puisse ajouter les données
        
        End If
        'test de la boîte de texte adresse
        If txt_ajout_code_postal.Text = "" Then
        
            MsgBox "Veuillez remplir le champ code postal s'il vous plaît !", , "Vide"
            txt_ajout_code_postal.SetFocus 'remise du Setfocus sur la boites de texte pour faciliter l'encodage
            Exit Sub                                    'Exit Sub pour sortir du bouton afin qu'il nenregistre pas le contact et que l'on puisse ajouter les données
        
        End If
        'Fin des tests sur les boîtes de texte
        
        int_reponse = MsgBox("Etes-vous sûr de vouloir enregistrer " & txt_ajout_nom.Text & " " & txt_ajout_prenom.Text & " ?", vbYesNo + vbExclamation, "Enregistrer")
    
        If int_reponse = vbYes Then
            
            rst.AddNew 'ouverture d'un espace pour un nouvel enregistrement
            'Affectation des champs de la base de données avec le contenu des boîtes de texte
            rst!nom = txt_ajout_nom.Text
            rst!prenom = txt_ajout_prenom.Text
            rst!adresse = txt_ajout_adresse.Text
            rst!code_postal = txt_ajout_code_postal.Text
            rst!localite = txt_ajout_localite.Text
                    
            rst.Update                          'mise à jour du recordset
            bdd_etiquettes.Refresh       'Refresh : rafraichit la base de données
            
            'Effacement des boîtes de texte
            txt_ajout_nom.Text = ""
            txt_ajout_prenom.Text = ""
            txt_ajout_adresse.Text = ""
            txt_ajout_localite.Text = ""
            txt_ajout_code_postal.Text = ""
            
            'Passage de la propriété Enable à False pour rendre invisible la frame_ajout_donnee
            frame_ajout_donnee.Visible = False
            
            'Passage de la propriété Enabled à True pour réactiver certains boutons
            bou_liste_contact.Enabled = True
            bou_supprimer_contact.Enabled = True
            
        End If

'rst.Close                   'fermeture du recordset
'ma_bdd.Close            'fermeture de la base de données
'Workspaces(0).Close 'fermeture de l'espace de travail

'Set ma_bdd = Nothing 'vidage de la variable
'Set ws = Nothing 'vidage de la variable de l'espace de travail

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton enregistrer un nouveau contact.")
    
End Sub

Private Sub bou_fermer_frame_choix_personne_Click()

On Error GoTo erreur 'Gestion des erreurs

'Passage de la propriété Visible à false afin que la frame n'apparaisse plus
frame_choix_personne.Visible = False

'Passage de la propriété Enabled à True afin que le focus des boutons soient remis
bou_nouveau_contact.Enabled = True
bou_supprimer_contact.Enabled = True

'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
'ne pas créér de bug lors du prochain choix de personne à inprimer
Call PROCEDURE_VIDER_TABLE_TEMPORAIRE

'Rafraichissement du ControlData nommé Data1 afin que la requête qui est exécutée, soit prise en compte
Data1.Refresh

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton fermer de la frame choix de la personne.")

End Sub

Private Sub bou_fermer_frame_supprimer_Click()

On Error GoTo erreur 'Gestion des erreurs

'Passage de la propriété Visible à false afin que la frame n'apparaisse plus
frame_supprimer.Visible = False

'Passage de la propriété Enabled à True afin que le focus des boutons soient remis
bou_nouveau_contact.Enabled = True
bou_liste_contact.Enabled = True

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton fermer de la frame supprimer.")

End Sub

Private Sub bou_imprimer_Click()

On Error GoTo erreur 'Gestion des erreurs

'appel l'état Crystal Report et l'affiche avec les données
CrystalReport1.Action = 1

'Passage de la propriété Visible à false afin que la frame n'apparaisse plus
frame_choix_personne.Visible = False

'Passage de la propriété Enabled à True afin que le focus des boutons soient remis
bou_nouveau_contact.Enabled = True
bou_supprimer_contact.Enabled = True

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton imprimer dans la frame choix de la personne.")
 
End Sub

Private Sub bou_liste_contact_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration d'une variable pour la concaténation du nom et du prénom lors de l'affichage dans la list_box_choix_personne
Dim str_concatenation As String

frame_choix_personne.Visible = True
bou_nouveau_contact.Enabled = False
bou_supprimer_contact.Enabled = False
bou_imprimer.Enabled = False

list_box_choix_personne.Clear 'Effacement de la listeBox afin que les éléments ne s'y retrouvent pas plusieurs fois

bdd_etiquettes.Refresh 'Rafaîchissement de la base de données

'Boucle Do Until qui tourne et ajoute les nom et prénom tant qu'elle n'est pas à la fin du fichier
Do Until bdd_etiquettes.Recordset.EOF
        
    str_nom = bdd_etiquettes.Recordset!nom                      'ajout des données du champ nom dans la variable str_nom
    str_prenom = bdd_etiquettes.Recordset!prenom            'ajout des données du champs prénom dans la variable str_prenom
    str_concatenation = str_nom & " " & str_prenom          'concaténation des deux varibale pour afficher le nom et le prénom dans la listbox"
    list_box_choix_personne.AddItem str_concatenation
    bdd_etiquettes.Recordset.MoveNext
    
Loop
'Fin de la boucle

bou_tout_selectionner.SetFocus

'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
'ne pas créér de bug lors du prochain choix de personne à inprimer
Call PROCEDURE_VIDER_TABLE_TEMPORAIRE

'Rafraichissement du ControlData nommé Data1 afin que la requête qui est exécutée, soit prise en compte
Data1.Refresh

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton qui lance la frame choix de la personne, il s'intitule ETIQUETTES CONTACTS.")

End Sub

Private Sub bou_nouveau_contact_Click()

On Error GoTo erreur 'Gestion des erreurs

frame_ajout_donnee.Visible = True
bou_liste_contact.Enabled = False
bou_supprimer_contact.Enabled = False

'Placement du Setfocus afin de faciliter l'encodage
txt_ajout_nom.SetFocus

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton qui lance la frame nouveau contact.")

End Sub

Private Sub bou_quitter_Click()

'Code pour afficher une MsgBox lorsqu'on quitte le programme
Dim fin As Integer
    
        fin = MsgBox("Etes-vous sûr de vouloir quitter l'application ?", vbYesNo + vbExclamation, "Quitter")
        
        If fin = vbYes Then
            'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
            'ne pas créér de bug lors du prochain choix de personne à inprimer
            Call PROCEDURE_VIDER_TABLE_TEMPORAIRE
            End
            
        End If
        
Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton qui permet de quitter le programme sur écran principal.")

End Sub

Private Sub bou_supprimer_contact_Click()

On Error GoTo erreur 'Gestion des erreurs

Dim str_concatenation As String

'Affichage et activation ou désactivation de certains control
frame_supprimer.Visible = True
bou_nouveau_contact.Enabled = False
bou_liste_contact.Enabled = False

bdd_etiquettes.Recordset.MoveFirst 'placement sur le premier enregistrement afin qu'il soit toujours placé sur un enregistrement

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton qui lance la frame supprimer un contact.")

End Sub

Private Sub bou_supprimer_dernier_Click()

On Error GoTo erreur 'Gestion des erreurs

    'Code pour arriver au dernier enregistrement
    bdd_etiquettes.Recordset.MoveLast

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton dernier dans la suppression d'un contact.")

End Sub

Private Sub bou_supprimer_precedent_Click()

On Error GoTo erreur 'Gestion des erreurs

    'Code pour revenir au pécédent avec teste pour eviter un bug lorsqu'on arrive au premier
    bdd_etiquettes.Recordset.MovePrevious

    If bdd_etiquettes.Recordset.BOF = True Then 'Test

        bdd_etiquettes.Recordset.MoveFirst
    
    End If

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton précédent dans la suppression d'un contact.")

End Sub

Private Sub bou_supprimer_premier_Click()

On Error GoTo erreur 'Gestion des erreurs

    bdd_etiquettes.Recordset.MoveFirst 'Code pour arriver au premier enregistrement

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton premier dans la suppression d'un contact.")
    
End Sub

Private Sub bou_supprimer_suivant_Click()

On Error GoTo erreur 'Gestion des erreurs

    'Code pour passer au suivant avec teste pour eviter un bug lorsqu'on arrive au dernier
    bdd_etiquettes.Recordset.MoveNext

    If bdd_etiquettes.Recordset.EOF = True Then 'Test

        bdd_etiquettes.Recordset.MoveLast
    
    End If

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton suivant dans la suppression d'un contact.")

End Sub

Private Sub bou_tout_deselectionner_Click()

On Error GoTo erreur 'Gestion des erreurs

Dim int_i As Integer

For int_i = 0 To list_box_choix_personne.ListCount - 1

  list_box_choix_personne.Selected(int_i) = False
  
Next int_i

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton nommé tout déselectionner dans la frame choix de la personne.")

End Sub

Private Sub bou_tout_selectionner_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration de la variable pour la boucle FOR
Dim int_i As Integer

For int_i = 0 To list_box_choix_personne.ListCount - 1

  list_box_choix_personne.Selected(int_i) = True
  
Next int_i

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton nommé tout sélectionner dans la frame choix de la personne.")

End Sub

Private Sub bou_valider_choix_personnes_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration des variable
Dim str_nom_prenom As String
Dim int_i As Integer
Dim int_position As Integer

Set ws = DBEngine.Workspaces(0)                                                      'ouverture de l'espace de travail
Set ma_bdd = ws.OpenDatabase(bdd_etiquettes.DatabaseName)           'ouverture de la base de données
Set rst = ma_bdd.OpenRecordset("TABLE_TEMPORAIRE")                'ouverture du RecordSet

'Boucle For pour ajouter les éléments dans la TABLE_TEMPORAIRE
'grâce au champ code qui est mis en relation avec le champ code
'de la table DONNEES
For int_i = 0 To list_box_choix_personne.ListCount - 1

  If list_box_choix_personne.Selected(int_i) = True Then
        
        rst.AddNew
        rst!code = int_i + 1
        rst.Update
      
   End If

Next

bou_imprimer.Enabled = True

Data1.Refresh

'rst.Close
'ma_bdd.Close
'Workspaces(0).Close

'Set ma_bdd = Nothing 'vidage de la variable
'Set ws = Nothing 'vidage de la variable de l'espace de travail

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton valider choix du contact.")
    
End Sub

Private Sub bou_valider_choix_supprimer_Click()

On Error GoTo erreur 'Gestion des erreurs

    'Déclaration de la variable pour la MsgBox
    Dim fin As Integer

    fin = MsgBox("Etes-vous sûr de vouloir supprimer  ?", vbYesNo + vbExclamation, "Supprimer")
    
    If fin = vbYes Then
    
        bdd_etiquettes.Recordset.Delete
        bdd_etiquettes.Recordset.MoveNext
    
    End If
    
Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton valider la suppression dans la frame supprimer un contact.")
    
End Sub

Private Sub Form_Load()

'Utilisation de l'App.Path pour que l'application trouve toujours le fichier s'il est présente sur l'ordinateur
bdd_etiquettes.DatabaseName = App.Path & "\bdd_etiquettes.mdb"
Data1.DatabaseName = App.Path & "\bdd_etiquettes.mdb"
CrystalReport1.ReportFileName = App.Path & "\test_rapport.rpt"
CrystalReport2.ReportFileName = App.Path & "\rpt_listing_contacts.rpt"

' Charge les icones dans les menus grâce à l'OCX HookMenu
' ------------------------------------------------------------

    'Menu fichier/quitter
    HookMenu.SetBitmap mnuFichierQuitter, ImageList.ListImages(5).Picture
    
    'Menu fichier/listing contact
    HookMenu.SetBitmap mnuFichierListingContact, ImageList.ListImages(4).Picture
    
    'Menu fichier/nouveaucontact
    HookMenu.SetBitmap mnuFichierNouveauContact, ImageList.ListImages(3).Picture
    
    'Menu fichier/supprimer contact
    HookMenu.SetBitmap mnuFichierSupprimerContact, ImageList.ListImages(2).Picture
    
     'Menu fichier/imprimer
    HookMenu.SetBitmap mnuFichierImprimer, ImageList.ListImages(1).Picture
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo erreur 'Gestion des erreurs

'Code pour afficher une MsgBox lorsqu'on click sur la croix rouge
 Dim int_reponse As Integer
    
        int_reponse = MsgBox("Etes-vous sûr de vouloir quitter l'application ?", vbYesNo + vbExclamation, "Quitter")
        
        If int_reponse <> 6 Then Cancel = 1
        
        'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
            'ne pas créér de bug lors du prochain choix de personne à inprimer
        Call PROCEDURE_VIDER_TABLE_TEMPORAIRE
        
Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "bouton enregistrer un nouveau contact.")

End Sub

Private Sub mnuFichierImprimerListingContacts_Click()

On Error GoTo erreur 'Gestion des erreurs

CrystalReport2.Action = 1

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "Fichier/Imprimer/imprimer listing des contacts,")
    
End Sub

Private Sub mnuAide_Click()

'Lancement de feuille A propos de Easy Etiquettes 1,0
frmAbout.Show

End Sub

Private Sub mnuFichierListingContact_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration d'une variable pour la concaténation du nom et du prénom lors de l'affichage dans la list_box_choix_personne
Dim str_concatenation As String

frame_choix_personne.Visible = True
bou_nouveau_contact.Enabled = False
bou_supprimer_contact.Enabled = False
bou_imprimer.Enabled = False

list_box_choix_personne.Clear 'Effacement de la listeBox afin que les éléments ne s'y retrouvent pas plusieurs fois

bdd_etiquettes.Refresh 'Rafaîchissement de la base de données

'Boucle Do Until qui tourne et ajoute les nom et prénom tant qu'elle n'est pas à la fin du fichier
Do Until bdd_etiquettes.Recordset.EOF
        
    str_nom = bdd_etiquettes.Recordset!nom                      'ajout des données du champ nom dans la variable str_nom
    str_prenom = bdd_etiquettes.Recordset!prenom            'ajout des données du champs prénom dans la variable str_prenom
    str_concatenation = str_nom & " " & str_prenom          'concaténation des deux varibale pour afficher le nom et le prénom dans la listbox"
    list_box_choix_personne.AddItem str_concatenation
    bdd_etiquettes.Recordset.MoveNext
    
Loop
'Fin de la boucle

bou_tout_selectionner.SetFocus

'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
'ne pas créér de bug lors du prochain choix de personne à inprimer
Call PROCEDURE_VIDER_TABLE_TEMPORAIRE

'Rafraichissement du ControlData nommé Data1 afin que la requête qui est exécutée, soit prise en compte
Data1.Refresh

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "Menu Fichier /Etiquettes contact -> qui lance la frame choix de la personne.")

End Sub

Private Sub mnuFichierNouveauContact_Click()

On errot GoTo erreur 'Gestion des erreurs

frame_ajout_donnee.Visible = True
bou_liste_contact.Enabled = False
bou_supprimer_contact.Enabled = False

'Placement du Setfocus afin de faciliter l'encodage
txt_ajout_nom.SetFocus

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "Menu Fichier /Nouveau contact -> qui lance la frame nouveau contact.")

End Sub

Private Sub mnuFichierQuitter_Click()

'Code pour afficher une MsgBox lorsqu'on quitte le programme
Dim fin As Integer
    
        fin = MsgBox("Etes-vous sûr de vouloir quitter l'application ?", vbYesNo + vbExclamation, "Quitter")
        
        If fin = vbYes Then
        
            'Appel de cette procédure pour vider la table temporaire de tous ses éléments afin de
            'ne pas créér de bug lors du prochain choix de personne à inprimer
            Call PROCEDURE_VIDER_TABLE_TEMPORAIRE
            End
            
        End If
        
Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "Menu fichier / Quitter.")
        
End Sub

Private Sub mnuFichierSupprimerContact_Click()

On Error GoTo erreur 'Gestion des erreurs

Dim str_concatenation As String

'Affichage et activation ou désactivation de certains control
frame_supprimer.Visible = True
bou_nouveau_contact.Enabled = False
bou_liste_contact.Enabled = False

bdd_etiquettes.Recordset.MoveFirst 'placement sur le premier enregistrement afin qu'il soit toujours placé sur un enregistrement

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "Menu fichier / Supprimer contacts -> lance la frame supprimer un contact.")
    
End Sub

Private Sub mnuImprimerEtiquettesContacts_Click()

On Error GoTo erreur 'Gestion des erreurs

'Déclaration d'une variable pour la concaténation du nom et du prénom lors de l'affichage dans la list_box_choix_personne
Dim str_concatenation As String

'Set ws = DBEngine.Workspaces(0)                                                      'ouverture de l'espace de travail
'Set ma_bdd = ws.OpenDatabase(bdd_etiquettes.DatabaseName)          'ouverture de la base de données
'Set rst = ma_bdd.OpenRecordset("DONNEES")                                 'ouverture du RecordSet

frame_choix_personne.Visible = True
bou_nouveau_contact.Enabled = False
bou_supprimer_contact.Enabled = False
bou_imprimer.Enabled = False

list_box_choix_personne.Clear 'Effacement de la listeBox afin que les éléments ne s'y retrouvent pas plusieurs fois

bdd_etiquettes.Refresh 'Rafaîchissement de la base de données

'Boucle Do Until qui tourne et ajoute les nom et prénom tant qu'elle n'est pas à la fin du fichier
Do Until bdd_etiquettes.Recordset.EOF
        
    str_nom = bdd_etiquettes.Recordset!nom                      'ajout des données du champ nom dans la variable str_nom
    str_prenom = bdd_etiquettes.Recordset!prenom            'ajout des données du champs prénom dans la variable str_prenom
    str_concatenation = str_nom & " " & str_prenom          'concaténation des deux varibale pour afficher le nom et le prénom dans la listbox"
    list_box_choix_personne.AddItem str_concatenation
    bdd_etiquettes.Recordset.MoveNext
    
Loop
'Fin de la boucle

bou_tout_selectionner.SetFocus

Call PROCEDURE_VIDER_TABLE_TEMPORAIRE
Data1.Refresh

'rst.Close
'ma_bdd.Close
'Workspaces(0).Close

'Set ma_bdd = Nothing 'vidage de la variable
'Set ws = Nothing 'vidage de la variable de l'espace de travail

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "menu imprimer / imprimer etiquettes des contacts.")
    
End Sub

Private Sub mnuImprimerListingContacts_Click()

On Error GoTo erreur 'Gestion des erreurs

CrystalReport2.Action = 1

Exit Sub
erreur:
    Call fct_journal_erreurs(Err.Number, Err.description, "menu imprimer / imprimer listing des contacts.")
    
End Sub

Private Sub Timer1_Timer()

'Affiche l'heure dans le StatuBar
StatusBar1.Panels(3).Text = Time

End Sub

Private Sub txt_ajout_adresse_KeyPress(KeyAscii As Integer)

'Force la majuscule sur la première lettre
If txt_ajout_adresse.SelStart = 0 And KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32

'Filtre
If InStr("AZERTYUIOPQSDFGHJKLMWXCVBNazertyuiopmlkjhgfdsqwxcvbnéèàçêöëïäî-0123456789'" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

Private Sub txt_ajout_code_postal_KeyPress(KeyAscii As Integer)

'Filtre
If InStr("0123456789" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

Private Sub txt_ajout_localite_KeyPress(KeyAscii As Integer)

'Force la majuscule sur la première lettre
If txt_ajout_localite.SelStart = 0 And KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32

'Filtre
If InStr("AZERTYUIOPQSDFGHJKLMWXCVBNazertyuiopmlkjhgfdsqwxcvbnéèàçêöëïäî-" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

Private Sub txt_ajout_nom_KeyPress(KeyAscii As Integer)

'Force la majuscule sur la première lettre
If txt_ajout_nom.SelStart = 0 And KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32

'Filtre
If InStr("AZERTYUIOPQSDFGHJKLMWXCVBNazertyuiopmlkjhgfdsqwxcvbnéèàçêöëïäî-" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

Private Sub txt_ajout_prenom_KeyPress(KeyAscii As Integer)

'Force la majuscule sur la première lettre
If txt_ajout_prenom.SelStart = 0 And KeyAscii > 96 And KeyAscii < 123 Then KeyAscii = KeyAscii - 32

'Filtre
If InStr("AZERTYUIOPQSDFGHJKLMWXCVBNazertyuiopmlkjhgfdsqwxcvbnéèàçêöëïä-" & Chr(8) & Chr(32), Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

Public Sub PROCEDURE_VIDER_TABLE_TEMPORAIRE()

'Procedure qui permet de mettre la TABLE_TEMPORAIRE à vide afin que les enregistrement ne se multiplient pas
'Utilisation d'une requête SQl afin que la vitesse d'éxecution soit plus rapide et plus efficace.
Dim req_sql As String

Set ma_bdd = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\bdd_etiquettes.mdb")

req_sql = "DELETE FROM TABLE_TEMPORAIRE" 'syntaxe de la requête

ma_bdd.Execute req_sql 'Execution de la requête

ma_bdd.Close 'fermeture de la base de données

End Sub