Création d'étiquettes vb6 / crystal report
Description
Ce code à était élaboré pour un projet scolaire, je dois par rapport à une BDD imprimer des étiquettes.
Ce programme permet d'ajouter des contacts et des les supprimer !
Lors de l'impression, on peut sélectionner les contacts que l'on veut sous forme d'étiquettes grâce à une ListeBox où l'on peut sélectionner les éléments.
J'ai ajouté une gestion d'erreurs sui me crée un fichier texte comprenant l'erreur etc
Le projet au niveau de l'état crystal report contient quelques erreurs, je suis ouvert aux modifications car si je peux finaliser au maximum ce projet j'en serais ravi.
Merci à tous j-il
Ce programme permet d'ajouter des contacts et des les supprimer !
Lors de l'impression, on peut sélectionner les contacts que l'on veut sous forme d'étiquettes grâce à une ListeBox où l'on peut sélectionner les éléments.
J'ai ajouté une gestion d'erreurs sui me crée un fichier texte comprenant l'erreur etc
Le projet au niveau de l'état crystal report contient quelques erreurs, je suis ouvert aux modifications car si je peux finaliser au maximum ce projet j'en serais ravi.
Merci à tous j-il
Source / Exemple :
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
Codes Sources
A voir également
- Création d'étiquettes vb6 / crystal report
- Crystal report alternative c# ✓ - Forum C# / .NET
- Crystal report vb6 - Forum Visual Basic
- Vb.net report generator - Forum VB.NET
- Création d'état Crystal Report via Visual Basic 6 - Forum Visual Basic
- Crystal report php ✓ - Forum PHP
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.