Docstoc

ECOLE NATIONALE DES INGENIEURS DES TRAVAUX AGRICOLES DE BORDEAUX DEPARTEMENT ENTREPRISE ET SYSTEME UNITE DE FORMATI

Document Sample
ECOLE NATIONALE DES INGENIEURS DES TRAVAUX AGRICOLES DE BORDEAUX DEPARTEMENT ENTREPRISE ET SYSTEME UNITE DE FORMATI Powered By Docstoc
					            ECOLE NATIONALE DES INGENIEURS DES TRAVAUX
                      AGRICOLES DE BORDEAUX

                    DEPARTEMENT ENTREPRISE ET SYSTEME

                        UNITE DE FORMATION
               INFORMATIQUE ET GENIE DES EQUIPEMENTS

                                        




                            ACCESS VBA




                                  Exercices




                                                    Jérôme Steffe Juin 2003




ENITA de Bordeaux              Auteur : J. Steffe                        1
Exercice 1 : Sur un formulaire, faire un bouton qui permette d’afficher le nombre de produits
commandés avec le total en € dans une boite de dialogue.
NB : le nombre de produits, le libellé du produit ainsi que le prix unitaire seront initialisés
dans des variables.

Objectifs : travail sur les variables (déclaration, initialisation), commentaires, concaténation.




Corrigé
'déclaration des variables
Dim n As Integer
Dim prix As Single
Dim tot As Single
Dim prod As String


'initialisation des variables
n = 10
prix = 20
prod = "chaise"

‘calcul et affichage résultat
tot = n * prix

MsgBox "vous avez commandé " & n & " " & prod & "s pour un montant de " & tot & " €"


Exercice 2 : Même exercice que précédemment mais en faisant saisir les données à
l’utilisateur au travers de zones de texte et en affichant le résultat sur le formulaire.




ENITA de Bordeaux                       Auteur : J. Steffe                                          2
Objectifs : récupération de valeurs saisies par l’utilisateur. Affichage de résultats sur un
formulaire.


Corrigé
Private Sub bt_calcul_Click()

'déclaration des variables
Dim n As Integer
Dim prix As Single
Dim tot As Single
Dim prod As String

'initialisation des variables
n = zt_nb.Value
prix = zt_prix.Value
prod = zt_prod.Value

'calcul et affichage résultat
tot = n * prix

eti_resu.Caption = "vous avez commandé " & n & " " & prod & "s pour un montant de " & tot
& " €"

End Sub




ENITA de Bordeaux                    Auteur : J. Steffe                                   3
Exercice 3 : Faire saisir à l’utilisateur un nombre n (entier) et afficher la somme des entiers de
1 à n à l’écran.
NB : on s’assurera que l’utilisateur ne saisit pas des chiffres inférieurs à 10 ou supérieurs à
100




Objectifs : utilisation de structure de traitement (boucle, condition), contrôle de cohérence.

Corrigé
Private Sub bt_calcul_Click()
'déclaration des variables
Dim n As Integer
Dim i As Integer
Dim somme As Integer

'initialisation des variables
n = zt_n.Value

'contrôle de cohérence
If n < 10 Or n > 100 Then
   MsgBox "Vous devez saisir un nombre compris entre 10 et 100"
Else
   For i = 1 To n
      somme = somme + i
   Next
   eti_resu.Caption = somme

End If
Exercice 4 : On désire que sur le double-clic d’un contrôle, sa couleur de fond change ainsi
que la couleur du texte (les 2 couleurs doivent pouvoir être paramétrée).

Objectifs : utilisation de procédure, propriétés de contrôles.


Corrigé
Private Sub Texte5_DblClick(Cancel As Integer)
  colorier Screen.ActiveControl, 16711680, 178995952
End Sub

Procédure à placer dans un module.
Sub colorier(ctrl As Control, couleurfond As Single, couleurtexte As Single)
  ctrl.BackColor = couleurfond
  ctrl.ForeColor = couleurtexte


ENITA de Bordeaux                       Auteur : J. Steffe                                       4
End Sub


Exercice 5 : Créer un formulaire sur la table client et créer avec l’assistant un bouton de
déplacement précédent.
Visualiser le code.
Créer une procédure qui permette de réutiliser ce code sur tous les formulaires.

Objectifs : utilisation de procédure, portée du code.

Corrigé
Private Sub Bt_precedent_Click()
  prec
End Sub

Module
Sub prec()
  On Error GoTo Err_Commande3_Click


  DoCmd.GoToRecord , , previous

Exit_Commande3_Click:
  Exit Sub

Err_Commande3_Click:
  MsgBox "vous êtes au début du recordset !!"
  Resume Exit_Commande3_Click

End Sub
Exercice 6 : Créer une procédure qui change la police de caractère ainsi que la couleur de
toutes les zones de textes d’un formulaire.

Objectifs : utilisation de procédure, instruction With.

Corrigé
Sub colorier ()
Dim ctl As Control
For Each ctl In Screen.ActiveForm
  With ctl

    If ctl.ControlType = acTextBox Then
       .ForeColor = 16711680
       .FontName = "modern"
    End If
  End With
Next ctl
End Sub




ENITA de Bordeaux                       Auteur : J. Steffe                               5
Exercice 7 : Afficher la liste de tous les noms de contrôle sur un formulaire.

Objectifs : utilisation de procédure, instruction for each, collection.

Corrigé
Dim i As Integer
For i = 0 To Me.Controls.Count - 1
  MsgBox Me.Controls(i).Name
Next i



Exercice 8 : Créer une fonction qui permet de tester si un formulaire est ouvert ou non.




Objectifs : utilisation de fonction, collection.

Corrigé
Private Sub bt_test_Click()
  MsgBox ouvert(zt_nom.Value)
End Sub

Module
Function ouvert(nomform As String) As Boolean

Dim i As Integer
ouvert = False
'passe en revue tous les formulaires ouverts dans la collection form
For i = 0 To Forms.Count - 1
   If Forms(i).Name = nomform Then
      ouvert = True
   End If
Next i

End Function

Exercice 9 : Créer un formulaire de paramétrage pour faire choisir une ville à l’utilisateur afin
de ne modifier que les fiches des clients habitant cette ville dans un autre formulaire.
On utilisera dans un premier temps une macro pour ouvrir le formulaire.




ENITA de Bordeaux                        Auteur : J. Steffe                                    6
Dans un deuxième temps, on exécutera cette macro dans le code via l’instruction
Docmd.runmacro.
On traduira ensuite cette macro en code VB.




Objectifs : travail sur plusieurs objets ouverts, instruction DoCmd, traduction de macro en
code.

Corrigé
Private Sub bt_client_Click()
       DoCmd.OpenForm "Clients", acNormal, "", "[ville_cl]=[Forms]![menug]![lm_ville]",
, acNormal
End Sub


Exercice 10 : Créer un formulaire de paramétrage pour faire choisir une ville à l’utilisateur et
n’afficher sur un état que la liste des clients habitant cette ville.




Objectifs : travail sur plusieurs objets ouverts, instruction DoCmd.

Corrigé
Private Sub bt_client_Click()
       DoCmd.OpenForm "Clients", acNormal, "", "[ville_cl]=[Forms]![menug]![lm_ville]",
, acNormal
End Sub




ENITA de Bordeaux                      Auteur : J. Steffe                                     7
Exercice 11 : Créer un formulaire de paramétrage pour faire choisir une promo, une
profession et une catégorie professionnelle à l’utilisateur et n’afficher sur un état que la liste
des élèves correspondants.




Objectifs : algorithmique, exercice de synthèse.

Corrigé
Private Sub Bt_Ok_adresse_Click()
On Error GoTo Err_Bt_Ok_adresse_Click

Dim textwhere As String
Dim sqlpromo As String
Dim sqlprofession As String, sqlcateg_prof As String
Dim operateur As String

' initialisation des variables
operateur = ""
sqlpromo = ""
sqlprofession = ""
sqlcateg_prof = ""

' paramétrage de la requête sur la promo
If lm_promo = "*" Then
  sqlpromo = ""
Else
  sqlpromo = " [promo] " & lm_critere_promo.Value & " '" & lm_promo.Value & "'"
  operateur = " and"
End If

' paramétrage de la requête sur la profession
If lm_profession = "*" Then
  sqlprofession = ""
Else
  If lm_critere_profession = "Comme" Then lm_critere_profession = "Like"
  sqlprofession = operateur & " [profession] " & lm_critere_profession.Value & " '" &
lm_profession.Value & "'"
  operateur = " and"


ENITA de Bordeaux                       Auteur : J. Steffe                                      8
 If lm_critere_profession = "Like" Then lm_critere_profession = "Comme"
End If

' paramétrage de la requête sur la categorie professionnelle
If lm_categ_prof = "*" Then
  sqlcateg_prof = ""
Else
  If lm_critere_categ_prof = "Comme" Then lm_critere_categ_prof = "Like"
  sqlcateg_prof = operateur & " [categorie_prof] " & lm_critere_categ_prof.Value & " '" &
lm_categ_prof.Value & "'"
  operateur = " and"
  If lm_critere_categ_prof = "Like" Then lm_critere_categ_prof = "Comme"
End If

' generation de la requete
textwhere = sqlpromo & sqlprofession & sqlcateg_prof

Debug.Print "*"; textwhere; "*"

' affichage de l'etat
DoCmd.OpenReport "edition_adresses_selon_criteres", A_PREVIEW, , textwhere
DoCmd.Maximize

Exit_Bt_Ok_adresse_Click:
  Exit Sub

Err_Bt_Ok_adresse_Click:
  MsgBox Error$
  Resume Exit_Bt_Ok_adresse_Click

End Sub
Exercice 12 : Créer une procédure qui affiche tous les clients.

Objectifs : Connexion, Recordset, parcours de recordset

Corrigé
Dim connex As ADODB.Connection
Dim r_client As New ADODB.Recordset
Dim fld As ADODB.Field

'paramétrage de la connexion
Set connex = CurrentProject.Connection

'ouverture du recordset
r_client.Open "select nom from Clients", connex, adOpenStatic

'passe en revue tous les champs
Do While Not r_client.EOF
   MsgBox r_client("nom")
   r_client.MoveNext


ENITA de Bordeaux                      Auteur : J. Steffe                              9
Loop


Exercice 13 : Créer une procédure qui affiche tous les champs texte de la table clients.

Objectifs : connexion Field, Recordset.

Corrigé
Dim connex As ADODB.Connection
Dim r As New ADODB.Recordset
Dim fld As ADODB.Field

Set connex = CurrentProject.Connection
r.Open "Clients", connex, adOpenStatic

'passe en revue tous les champs
For Each fld In r.Fields
   '202 = champ de type texte
   If fld.Type = 202 Then
      MsgBox fld.Name
   End If
Next fld


Exercice 14 : Créer une procédure qui affiche tous les clients dont le nom commence par une
valeur saisie par l’utilisateur.

Objectifs : Méthode FIND, Recordset.

Corrigé
Dim connex As ADODB.Connection
Dim r_client As New ADODB.Recordset
Dim fld As ADODB.Field
Dim val As String
Dim crit As String
Dim book As Variant


'paramétrage de la connexion
Set connex = CurrentProject.Connection

val = Me.zt_val.Value

'ouverture du recordset
r_client.Open "select nom from Clients", connex, adOpenStatic

'paramétrage du critère
crit = "nom like '" & val & "%'"

With r_client


ENITA de Bordeaux                      Auteur : J. Steffe                                  10
  'recherche l'enregistrement spécifié
  .Find crit, 0, adSearchForward

  If .EOF Then
     MsgBox "aucun nom ne commence par la valeur saisie"
  Else
     'affiche et trouve les autres noms
     Do While Not .EOF
        MsgBox r_client("nom")
        'stocke la position en cours
        book = .Bookmark
        'atteint l'enregistrement suivant (à partir du signet + 1 : paramètre skiprecord =1)
        .Find crit, 1, adSearchForward, book
     Loop
  End If
End With

NB : le bookmark était facultatif ici puisque le find effectue la recherche à partir de la position
en cours

Exercice 15 : Créer une procédure qui affiche le nom du client correspondant au code saisi
par l’utilisateur.

Objectifs : Méthode SEEK, Recordset.

Corrigé
Private Sub bt_find_Click()
Dim connex As ADODB.Connection
Dim r_client As New ADODB.Recordset
Dim fld As ADODB.Field
Dim val As String

'paramétrage de la connexion
Set connex = CurrentProject.Connection
val = Me.zt_val.Value

'ouverture du recordset
r_client.Open "Clients", connex, adOpenKeyset, adLockReadOnly, adCmdTableDirect

With r_client
 'définition de l'index du recordset
 .Index = "Primarykey"
 'recherche de l'enregistrement spécifié
 .Seek val, adSeekFirstEQ

  If .EOF Then
     MsgBox "aucun client ne correpond à ce code"
  Else
     'affiche le nom du client
     MsgBox r_client("nom")


ENITA de Bordeaux                        Auteur : J. Steffe                                     11
  End If
End With




ENITA de Bordeaux   Auteur : J. Steffe   12
Exercice 16 : Créer une procédure qui permette d’afficher les n plus grosses commandes d’un
client.




Objectifs : Ajout/suppression d’éléments dans une liste, algorithme à partir d’un recordset.


Corrigé :
Private Sub bt_afficher_Click()
Dim nb As Integer
Dim connex As Connection
Dim r_cde As New ADODB.Recordset
Dim txt_sql As String
Dim i As Integer

'ouvre un recordset en mode modification
Set connex = CurrentProject.Connection

'paramètre la requête qui renvoie le liste des commandes du client sélectionné classées par
ordre décroissant
txt_sql = "SELECT commandes.no_cde, date_cde, Sum(([pu]*[qte])) AS total FROM
commandes, detail_cde WHERE commandes.no_cde = detail_cde.no_cde and code_client='"
& Forms!n_plus_grosses_cdes!lm_client & "' GROUP BY commandes.no_cde, date_cde
ORDER BY Sum([pu]*[qte]) DESC"
Debug.Print txt_sql

'ouvre le recordset
r_cde.Open txt_sql, connex, adOpenKeyset, adLockOptimistic

'récupère le nb de commandes à afficher
nb = Forms!n_plus_grosses_cdes!zt_nb

'vide la liste à partir de la fin


ENITA de Bordeaux                      Auteur : J. Steffe                                      13
For i = Me.lm_cde.ListCount - 1 To 0 Step -1
  Me.lm_cde.RemoveItem (i)
Next i

i=1
'affiche les n plus grosses commandes du client
Do While (Not r_cde.EOF) And i <= nb
   Me.lm_cde.AddItem r_cde!no_cde & ";" & r_cde!date_cde
   r_cde.MoveNext
   i=i+1
Loop

   End Sub


NB : cet exercice aurait pu être réalisé directement avec une seule requête du type :
SELECT TOP 4 commandes.no_cde, commandes.date_cde, Sum(([pu]*[qte])) AS total
FROM commandes INNER JOIN detail_cde ON commandes.no_cde = detail_cde.no_cde
WHERE (((commandes.code_client)=[forms]![n_plus_grosses_cdes]![lm_client]))
GROUP BY commandes.no_cde, commandes.date_cde;

Conclusion : ne pas se lancer éperdument dans du code VBA !

Exercice 17 : Créer une procédure qui permette de réaffecter une ou plusieurs commandes à
un autre client.




Objectifs : Mise à jour de Recordset, sélection multiple dans une liste, contrôles de cohérence,
actualisation de liste

Corrigé
Private Sub bt_reaffecter_Click()
Dim nb As Integer
Dim i As Integer
Dim position As Integer
Dim connex As Connection


ENITA de Bordeaux                      Auteur : J. Steffe                                    14
Dim r_cde As New ADODB.Recordset
Dim no As Integer

'vérifie qu'on a choisi un nouveau client
If IsNull(lm_client_new) Then
   MsgBox "choisir un nouveau client"
Else
   'compte le nb de lignes sélectionnées
   nb = Forms!reassigner!lm_cde.ItemsSelected.Count

  'vérifie qu'on a sélectionné des cdes
  If nb = 0 Then
     MsgBox "vous devez sélectionner des commandes"
  Else
     'ouvre un recordset en mode modification
     Set connex = CurrentProject.Connection
     r_cde.Open "commandes", connex, adOpenKeyset, adLockOptimistic,
adCmdTableDirect

     'définit la propriété index pour rechercher les données
     r_cde.Index = "Primarykey"

    'pour chaque ligne sélectionnée dans la liste, réaffecte le code_client
    For i = 0 To nb - 1
       'récupère la position de la ligne sélectionnée
       position = Forms!reassigner!lm_cde.ItemsSelected(i)
       'récupère le no_cde de la ligne sélectionnée
       no = Forms!reassigner!lm_cde.ItemData(position)
       'atteint l'enregistrement correspondant
       r_cde.Seek no
       'change la valeur du code_client pour la ligne
       r_cde!code_client = Forms!reassigner!lm_client_new
       r_cde.Update
    Next i
    'actualise la liste des commandes
    lm_cde.Requery
  End If
End If
End Sub

Private Sub lm_client_AfterUpdate()
  lm_cde.Requery
  lm_client_new.Requery
End Sub

Autre solution : passer par une requête modification pour mettre à jour directement la table.
Private Sub bt_sql_Click()
Dim nb As Integer
Dim i As Integer
Dim position As Integer


ENITA de Bordeaux                      Auteur : J. Steffe                                       15
Dim no As Integer
Dim txt_sql As String


'vérifie qu'on a choisi un nouveau client
If IsNull(lm_client_new) Then
   MsgBox "choisir un nouveau client"
Else
   'compte le nb de lignes sélectionnées
   nb = Forms!reassigner!lm_cde.ItemsSelected.Count

  'vérifie qu'on a sélectionné des cdes
  If nb = 0 Then
     MsgBox "vous devez sélectionner des commandes"
  Else
     'enlève les avertissements
     DoCmd.SetWarnings False
     'pour chaque ligne sélectionnée dans la liste, réaffecte le code_client
     For i = 0 To nb - 1
        'récupère la position de la ligne sélectionnée
        position = Forms!reassigner!lm_cde.ItemsSelected(i)
        'récupère le no_cde de la ligne sélectionnée
        no = Forms!reassigner!lm_cde.ItemData(position)
        'paramétrer requête de modification
        txt_sql = "update commandes set code_client ='" & Me!lm_client_new & "' where
no_cde =" & no
        DoCmd.RunSQL txt_sql
     Next i
     'remet les avertissements
     DoCmd.SetWarnings True
     'actualise la liste des commandes
     lm_cde.Requery
  End If
End If
End Sub




ENITA de Bordeaux                   Auteur : J. Steffe                                  16
Exercice 18 : Créer une procédure qui permette de saisir une nouvelle ville dans la table ville
directement à partir de la liste « ville » du formulaire clients.




Objectifs : Propriété Limiter à liste, ajout d’enregistrements dans un recordset.


Corrigé :
Private Sub lm_ville_NotInList(NewData As String, Response As Integer)
'newdata = l'élément absent de la liste
'reponse = comportement de la liste (accepte ou refuse le nouvel élément)
   Dim msg As String
   Dim connex As ADODB.Connection
   Dim r_ville As New ADODB.Recordset

  msg = "Etes-vous sûr de vouloir ajouter '" & NewData & "' dans la liste des villes ?"
  'si l'urilisateur confirme la modif
  If MsgBox(msg, vbYesNo) = vbYes Then
       'paramétrage de la connexion
      Set connex = CurrentProject.Connection
      'ouverture du recordset
      r_ville.Open "ville", connex, adOpenKeyset, adLockOptimistic

     'ajoute la nouvelle ville
     r_ville.AddNew
     r_ville!ville_cl = NewData
     r_ville.Update
     'la liste est modifiée
     Response = acDataErrAdded
   Else
     'la modification n'est pas prise en compte
     Response = acDataErrDisplay
   End If
End Sub
Exercice 19 : Créer une procédure qui calcule combien de clients dans l’application sont
identiques à ceux de la table clients dans la base « base_externe ».



ENITA de Bordeaux                      Auteur : J. Steffe                                   17
Objectifs : Ouverture d’une base de données externe, algorithme, travail sur plusieurs
recordsets.

Corrigé :

Private Sub bt_comparer_Click()
  Dim connex As ADODB.Connection
  Dim r_client As New ADODB.Recordset
  Dim i As Integer
  Dim code As String
  Dim nombre As Integer

  Dim connex_ext As ADODB.Connection
  Dim r_client_ext As New ADODB.Recordset

  'paramétrage des connexions
   Set connex = CurrentProject.Connection
   Set connex_ext = New ADODB.Connection
   connex_ext.Open         "Provider=Microsoft.Jet.OLEDB.4.0;Data      source       =
c:\base_externe.mdb"

  'ouverture des recordsets
  r_client.Open "clients", connex, adOpenKeyset, adLockReadOnly, adCmdTableDirect
  r_client_ext.Open      "clients",   connex_ext,    adOpenKeyset,   adLockReadOnly,
adCmdTableDirect

  r_client_ext.Index = "Primarykey"
  nombre = 0
  'parcourt la table client de la base en cours
  Do While Not r_client.EOF
     'récupère le code client de la ligne en cours
     code = r_client!code_client
     'cherche le code client dans la base de données externe
     r_client_ext.MoveFirst
     r_client_ext.Seek code, adSeekFirstEQ
     'si le code n'a pas été trouvé, incrémente le compteur de 1
     If Not r_client_ext.EOF Then
        nombre = nombre + 1
     End If


ENITA de Bordeaux                      Auteur : J. Steffe                          18
    r_client.MoveNext
  Loop
  MsgBox "il y a " & nombre & " clients identiques entre les 2 bases"
End Sub


Exercice 20 : Sur un état, faire en sorte que les enregistrements soient affichés dans des
couleurs alternées.

Exemple :




Objectifs : Personnalisation d’états

Corrigé
Private Sub Détail1_Format(Cancel As Integer, FormatCount As Integer)
  'change de couleur à chaque nouvel enregistrement
  If Détail1.BackColor = 13816530 Then
     Détail1.BackColor = vbWhite
  Else
     Détail1.BackColor = 13816530
  End If

End Sub


Exercice 21 : Lancer un mailing Word depuis Access en demandant à l’utilisateur de choisir
les éléments à imprimer.




Objectifs : Pilotage de Word depuis Access : Automation, Utilisation de signets dans Word,
gestion de mailing piloté par Access



ENITA de Bordeaux                      Auteur : J. Steffe                              19
Corrigé :
Private Sub bt_mailing_access_Click()
On Error Resume Next
Dim W_App As Object
Set W_App = CreateObject("Word.Application")
Dim rs As New ADODB.Recordset
Dim connex As ADODB.Connection
Dim docWord As Word.Document
Dim txt_sql As String

'paramétrage de la connexion
Set connex = CurrentProject.Connection

'paramétrage de la requête
txt_sql = "select * from clients"
If zt_where.Value <> "" Then
   txt_sql = txt_sql & " where " & zt_where.Value
End If

'ouverture du recordset
rs.Open txt_sql, connex, adOpenStatic
rs.MoveFirst
   With W_App
     'rend invisible l'ouverture de Word
     .Visible = False
     'pour chaque client, imprime le document parès avoir inséré ses informations
     Do Until rs.EOF
        'ouverture du document dasn lequel des signets ont déjà été incorporés
        .Documents.Open ("c:\doc2.doc")
        'se place sur le signet code_client défini dans le document Word
        .ActiveDocument.Bookmarks("code").Select
        .Selection.InsertAfter rs.Fields("code_client")
        .ActiveDocument.Bookmarks("nom").Select
        .Selection.InsertAfter rs.Fields("nom")
        'imprime le document
        .ActiveDocument.PrintOut
        'ferme le document sans enregistrer les changements
        .ActiveDocument.Close wdDoNotSaveChanges
        rs.MoveNext
     Loop
     rs.Close
     Set rs = Nothing
     MsgBox "mailing terminé"
     .Quit
   End With
   Set W_App = Nothing
End Sub
Exercice 21 : Lancer un mailing Word depuis Access en affichant les documents de fusion
pour laisser la possibilité à l’utilisateur de les modifier.



ENITA de Bordeaux                    Auteur : J. Steffe                             20
Objectifs : Pilotage de Word depuis Access : Automation, Utilisation de l’objet Mailmerge.

Corrigé
Private Sub bt_mailing_Click()
Dim docWord As Word.Document

'lancement de Word
Dim appWord As New Word.Application

'affiche Word à l'écran
appWord.Visible = True

With appWord
  'ouverture de la lettre type (les champs de fusion y ont déjà été incorporés à aprtir de Word)
  .Documents.Open FileName:="C:\doc2.doc"
  'définit le type de document comme lettre types
  .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
  'lie la source de données
  'NB : si on spécifie uniquement le nom du fichier sans spécifier de table ni de querystring,
  'Word proposera à l'utilisateur la table ou la requête à utiliser pour la fusion
  .ActiveDocument.MailMerge.OpenDataSource Name:= _
         "C:\base_exos_VBA.mdb", _
         ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
         AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
         WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
         Format:=wdOpenFormatAuto, Connection:="TABLE Clients", SQLStatement:= _
         "SELECT * FROM [Clients]", SQLStatement1:=""
  'paramètre la requête pour la fusion
  .ActiveDocument.MailMerge.DataSource.QueryString = "SELECT * FROM [Clients]"
  'exécute la fusion vers un nouveau document
  With .ActiveDocument.MailMerge
         .Destination = wdSendToNewDocument
         'supprime les lignes vides quand les champs de fusion sont vides
         .SuppressBlankLines = True
         'définit le premier et le dernier enregistrement à fusionner
         With .DataSource
               .FirstRecord = wdDefaultFirstRecord
               .LastRecord = wdDefaultLastRecord
         End With
         'lance la fusion (pause = true indique que Word doit afficher une boite de message à
chaque erreur rencontrée)
         .Execute Pause:=True
  End With
End With
End Sub




ENITA de Bordeaux                      Auteur : J. Steffe                                    21
Exercice 22 : Créer un arbre qui affiche l’ensemble des clients ainsi que leurs commandes.
(S’arranger pour forcer l’ouverture de tous les nœuds).
Après avoir choisi une commande, on doit pouvoir lancer l’état qui permet d’imprimer son
détail.

Objectifs : Utilisation de l’activeX Treeview, recordset.




Corrigé
Private Sub Form_Open(Cancel As Integer)

Dim nod As MSComctlLib.Node
Dim connex As ADODB.Connection
Dim r_client As New ADODB.Recordset
Dim r_cde As New ADODB.Recordset
Dim code_cl As String

'paramétrage de la connexion
Set connex = CurrentProject.Connection

'ouverture du recordset
r_client.Open "select code_client, nom from clients", connex, adOpenStatic


'passe en revue tous les clients
Do While Not r_client.EOF
   'crée un noeud pour chaque client
   'Comme la clef ne peut être du numérique, on ajoute la lettre "L" au au code client
   code_cl = r_client("code_client")
   Tree_cdes.Nodes.Add , , "L" & code_cl, r_client("nom")

  'récupère la liste des cdes du client en cours


ENITA de Bordeaux                       Auteur : J. Steffe                               22
   r_cde.Open "select no_cde, date_cde from commandes where code_client ='" & code_cl &
"'", connex, adOpenStatic

  Do While Not r_cde.EOF
     'crée un noeud pour chaque commande
     'Comme la clef ne peut être du numérique, on ajoute la lettre "C" devant le no cde
     Tree_cdes.Nodes.Add "L" & r_client("code_client"), tvwChild, "C" & r_cde("no_cde"),
r_cde("date_cde")
     r_cde.MoveNext
  Loop
  r_cde.Close
  r_client.MoveNext
Loop
r_client.Close

‘force l’ouverture de tous les noeuds
For Each nod In Tree_cdes.Nodes
   nod.Expanded = True
Next
‘fait en sorte que le premier noeud soit visible
Set Tree_cdes.SelectedItem = Tree_cdes.Nodes(1)
Tree_cdes.Nodes(1).EnsureVisible

End Sub

Private Sub bt_cde_Click()
Dim no As String
Dim l As Integer

'récupère la clef du noeud sélectionné
no = Tree_cdes.SelectedItem.Key

'teste si on est sur un noeud client ou commande
If Left(no, 1) = "L" Then
    MsgBox "choisir une commande"
Else
    'extrait le no_de_cde
    l = Len(no)
    no = Mid(no, 2, l - 1)
   'ouvre l'état
   DoCmd.OpenReport "e_cde", acViewPreview, , "no_cde =" & no
End Sub

End If

Exercice 23 : Envoyer un mail à tous les clients.

Objectifs : Envoi de mails (sendobject)




ENITA de Bordeaux                        Auteur : J. Steffe                          23
Corrigé
Private Sub bt_mail_Click()
Dim email As String
Dim connex As ADODB.Connection
Dim r_pers As New ADODB.Recordset
Dim fld As ADODB.Field

On Error GoTo sortie

'paramétrage de la connexion
Set connex = CurrentProject.Connection

'ouverture du recordset
r_pers.Open "select adr_mail from pers_mail", connex, adOpenStatic

'enlève les avertissements
DoCmd.SetWarnings False

'passe en revue toutes les personnes
Do While Not r_pers.EOF
   ' envoi du fichier par mailenvoi mail
   DoCmd.SendObject , , , r_pers("adr_mail"), , , Forms!envoi_mail!zt_objet.Value,
Forms!envoi_mail!zt_objet.Value, False
   r_pers.MoveNext
Loop

'remet les avertissements
DoCmd.SetWarnings True


sortie:
  Exit Sub
End Sub




ENITA de Bordeaux                    Auteur : J. Steffe                              24
Exercice 24 : Réaliser un formulaire de paramétrage qui permet de choisir une date et
d’afficher les commandes passées ce jour-là. On utilisera le contrôle calendrier et on créera
des boutons pour faciliter la navigation.

Objectifs : Utilisation du contrôle calendrier.




Corrigé
Private Sub bt_aujourdhui_Click()
  cal.Today
  cal.Refresh
End Sub

Private Sub bt_etat_Click()
Dim txt_where As String

'repasse en format date américain
txt_where = "date_cde =#" & cal.Month & "/" & cal.Day & "/" & cal.Year & "#"
'ouvre l'état
DoCmd.OpenReport "e_cde", acViewPreview, , txt_where


End Sub

Private Sub bt_jour_moins_Click()
  cal.PreviousDay
  cal.Refresh
End Sub

Private Sub bt_jour_plus_Click()
  cal.NextDay
  cal.Refresh
End Sub



ENITA de Bordeaux                       Auteur : J. Steffe                                25
Private Sub bt_moismoins_Click()
  cal.PreviousMonth
  cal.Refresh
End Sub

Private Sub bt_moisplus_Click()
  cal.NextMonth
  cal.Refresh
End Sub

Exercice 25 : Créer une liste qui affiche toutes la tables de l’application.
Après le choix d’une table, on veut voir apparaître la liste des champs de la table.

Objectifs : Utilisation de tables système, gestion des listes, recordset




Corrigé
Private Sub lm_table_AfterUpdate()
'déclaration de variables
Dim conn As New adodb.Connection
Dim rs As New adodb.Recordset
Dim champ As Field
Dim nom_table As String
Dim chaine As String
Dim i As Integer

'récupère le nom de la table saisie dans la liste
nom_table = Forms!liste_formulaires!lm_table

'ouvre la connexion et le recordset de la table choisie
Set conn = CurrentProject.Connection
rs.Open "[" & nom_table & "]", conn, adOpenStatic

'vide la liste

'vide la liste à partir de la fin
For i = Me.lm_champ.ListCount - 1 To 0 Step -1
   Me.lm_champ.RemoveItem (i)
Next i


ENITA de Bordeaux                       Auteur : J. Steffe                             26
'balaye les champs du recordset et les ajoute à la liste
For Each champ In rs.Fields
   lm_champ.AddItem champ.Name
Next champ
End Sub




ENITA de Bordeaux                       Auteur : J. Steffe   27

				
DOCUMENT INFO
Shared By:
Categories:
Stats:
views:288
posted:11/14/2010
language:French
pages:27
Description: Access Vba Change a Forms Recordset document sample