IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Créer une interface entre un processus industriel et les services techniques avec Access

Cet article constitue la synthèse de cette discussion sur le forum Access.

Contexte de l'application

On dispose d'une multitude d'enregistrements de format CSV (dix millions par jour !). Si une anomalie survient dans le déroulement du processus industriel, le service technique doit analyser ces données.

L'application consiste à présenter un formulaire qui permet de sélectionner parmi la masse, un échantillon d'enregistrements CSV.

Ces enregistrements sont alors reformatés et exportés dans une feuille Excel qui en fera des graphiques.

Les techniques Access abordées

- créer un modèle d'importation de données ;

- importer tous les fichiers contenus dans un répertoire et ses sous-répertoires éventuels ;

- réexporter dans un fichier Excel, une sélection de ces enregistrements ;

- déclencher par le code une capture d'écran de la fenêtre Access et l'intégrer dans ce fichier Excel.

Pour réagir au contenu de cet article, un espace de dialogue vous est proposé sur le forum 2 commentaires Donner une note à l´article (5) 

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Prérequis

Ce tutoriel s'adresse à des utilisateurs qui maitrisent déjà les bases du logiciel Access.

Pour vérifier votre niveau parcourez ces tutoriels : si vous les comprenez facilement, vous êtes OK et si ce n'est pas le cas, insistez :

- pour commencer : Maxence Hubiche Access - Les Bases ;

- pour construire des requêtes : Jean Ballat Créer des requêtes simples ;

- pour construire un formulaire :Jean-Philippe Ambrosino le chapitre 2-1-2 de Mise en surbrillance d'un enregistrement dans un formulaire ;

- pour le VBA : Olivier Lebeau Initiation au VBA Office.

II. Le contexte

Un processus industriel livre à titre de contrôle, une série d'enregistrements sous la forme de fichiers CSV (Comma-separated values).

Image non disponible

Fichier CSV

La première ligne renseigne le nom des colonnes séparées entre elles par un délimiteur (dans notre cas, un point-virgule).

Les lignes suivantes énumèrent les valeurs de chaque enregistrement.

Pour fixer les idées, en 24 heures, chacune des huit machines (K1, K2…) produit environ 1,2 million d'enregistrements rangés dans différents répertoires.

Image non disponible

Quand une anomalie survient, on voudrait extraire de cette masse d'enregistrements, ceux qui méritent d'être analysés pour comprendre ce qui s'est mal passé.

L'idée est de créer un formulaire Access qui va permettre à l'utilisateur de cibler les enregistrements utiles pour les extraire de la masse et alimenter une feuille Excel qui les traduira en graphiques :

Image non disponible

Notre propos est de décrire le fonctionnement de l'interface Access.

III. Cahier des charges de l'application Access

À l'aide de quelques clics dans un formulaire, permettre à l'utilisateur de cibler les enregistrements utiles pour les transformer en graphiques.

III-A. Comment exprimer le choix des enregistrements CSV à extraire

Image non disponible

N.B. Pour les points 2 à 7, plusieurs cases peuvent être cochées simultanément.

C:\MesDocuments\PrintScreen\&1.jpg Le choix d'une (et une seule) machine est obligatoire.

C:\MesDocuments\PrintScreen\&2.jpg L'indication de la position précise une notion qui sera exploitée dans des lignes suivantes (3, 5 et 9).

C:\MesDocuments\PrintScreen\&3.jpg Cette ligne va de pair avec la ligne 2 :
- dans un 1er temps, on charge tous les fichiers des répertoires « Temperature_x », où « x » correspond à la lettre de la position :

Image non disponible

- dans un 2e temps, on élimine les enregistrements correspondant à des thermocouples dont la case n'est pas cochée.

C:\MesDocuments\PrintScreen\&4.jpg On charge tous les fichiers des répertoires « Temperature Furnance n », où « n » correspond à la case cochée :

Image non disponible

C:\MesDocuments\PrintScreen\&5.jpg Cette ligne va de pair avec la ligne 2 :

- on charge les fichiers contenus dans les répertoires « Logs Burners x », où « x » représente la position choisie à la ligne 2 :

Image non disponible

- dans ces enregistrements, on ne retient que ceux qui ont une valeur 100 pour les low_flame et 200 pour les high_flame.

C:\MesDocuments\PrintScreen\&6.jpg On charge tous les fichiers du répertoire « Outside Burner »

Image non disponible

mais on ne retient que les enregistrements qui concernent les cases cochées.

C:\MesDocuments\PrintScreen\&7.jpg On charge tous les fichiers « Tilting_x » où « x » correspond à la case cochée :

Image non disponible

C:\MesDocuments\PrintScreen\&8.jpg et C:\MesDocuments\PrintScreen\&9.jpg Ces deux choix sont mutuellement exclusifs : ou bien l'utilisateur spécifie un laps de temps, ou bien il donne une plage de N° de pièces.
Dans cette deuxième hypothèse, le programme va rechercher dans les fichiers des répertoires « Counter x », où « x » correspond aux positions cochées à la ligne 2, les instants qui bornent l'intervalle de temps :

Image non disponible

III-B. Extraction des enregistrements choisis

Un clic sur le bouton « Load ».

Image non disponible

Le programme balaie alors l'ensemble des répertoires pour importer dans la table « tInput » les enregistrements des fichiers *.csv ad hoc qui correspondent aux choix exprimés.

IV. Détail de la programmation

La db ne contient que trois objets :

IV-A. La table tInput

Image non disponible

Elle est vidangée à chaque exécution. Elle sert à recueillir les enregistrements importés des fichiers *.csv.

Les colonnes « Variable », « Temps » et « Valeur » correspondent respectivement aux colonnes « VarName », « TimeString » et « VarValue » des fichiers *.csv.

« TempsFormate » est la mise en forme type Date de « Temps » (texte).

IV-B. Le formulaire fCommande

Il a été présenté au chapitre précédent.

Le code associé à ce formulaire est détaillé plus loin dans cet article.

IV-C. Une requête « rOutputExcel »

Son SQL est régénéré à la volée lors de chaque exécution.

IV-D. Définition d'un modèle d'importation

Dans la barre des menus : Fichier>Données externes>Importer

Image non disponible




S'ouvre alors une fenêtre qui permet de désigner le fichier.



Image non disponible




On choisit n'importe lequel : ils ont tous la même structure :



http://claudeleloup.developpez.com/&99/L1528.jpg




Vient alors cette fenêtre :



Image non disponible




On clique sur Avancé…



Image non disponible

Ce qui permet d'établir la concordance du nom des colonnes avec la table « tInput » et ne prendre que les colonnes utiles et un clic sur « Enregistrer sous… »

Image non disponible

IV-E. Une routine pour importer tous les fichiers d'un répertoire et de ses sous-répertoires éventuels

 
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Option Compare Database
Option Explicit
Public Sub ImportCSV(Racine As String)
    On Error GoTo GestionErreurs
    Dim FSO As Scripting.FileSystemObject
    Dim sRep As Scripting.Folder
    Dim sSubRep As Scripting.Folder
    Dim sFichier As Scripting.File
    Set FSO = New Scripting.FileSystemObject
    Set sRep = FSO.GetFolder(Racine)
    'Boucle sur les fichiers
    For Each sFichier In sRep.Files
      'Importer
       DoCmd.TransferText acImportDelim, "ImportModele", "tInput", sFichier.Path, True
    Next sFichier
    'Récursivité pour les sous-répertoires
    For Each sSubRep In sRep.SubFolders
        ImportCSV sSubRep.Path
    Next sSubRep
    'Libérer
    Set sRep = Nothing
    Set FSO = Nothing
    Exit Sub
GestionErreurs:
    Select Case Err.Number
      Case 76
         MsgBox "Le répertoire " & Racine & " est absent !", vbCritical
      Case Else
        MsgBox "Erreur N° " & Err.Number & " " & Err.Description & vbLf _
                  & "dans ImportCSV().", vbCritical
    End Select
    
End Sub

Explication du code (les nombres en gras indiquent les N° de lignes)

Le paramètre « Racine » est le chemin d'un répertoire (encadré de doubles- quotes « " »).

Exemple d'appel : Call ImportCSV( "C:\ApplicationAccess\FichiersCsv").

5-8 : la définition de ce type de variables nécessite d'installer la bibliothèque Microsoft Scripting Runtime

Image non disponible

10 : on se place dans le répertoire donné en paramètre.

12-15 : on boucle sur chaque fichier contenu dans ce répertoire. Ligne 14, on importe le fichier :

Image non disponible

D'une manière générale, pour se documenter sur la signification d'une partie de code :
- placer le curseur de la souris à l'intérieur d'un mot-clé ;
- enfoncer la touche <F1>.
L'aide Access s'ouvre à la bonne page.

Image non disponible

16-19 : quand on a traité tous les fichiers de ce répertoire, on regarde si ce dernier contient lui-même un ou plusieurs sous-répertoires. Si c'est le cas, la sub appelle une sub (elle-même !) avec comme paramètre ce sous-répertoire (c'est ce qu'on appelle la récursivité)… et ainsi de suite jusqu'à épuisement de l'arborescence.

20-23 : on sort, proprement.

24-32 : s'il s'avérait qu'un répertoire manque dans l'arborescence, Access lèverait une erreur N° 76

Image non disponible

En 26-27, on trappe cette erreur et on affiche ce message, plus explicite, pour informer l'utilisateur :

Image non disponible

V. Le code associé au formulaire

V-A. Une fonction qui indique si au moins une case a été cochée sur une ligne

 
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Public Function LignePresente(Ligne As String) As Boolean
  Dim ctl As Control
  For Each ctl In Me.Controls
    If ctl.Name Like Ligne & "*" Then
        If ctl = -1 Then
            LignePresente = True
            Exit Function
        End If
    End If
  Next ctl
End Function

Explication du code

Le paramètre correspond au sigle d'une ligne de cases à cocher.

: on définit un objet contrôle. Ce choix implique le chargement de la bibliothèque Microsoft DAO x.x Library

Image non disponible

3-10 : on parcourt la collection des contrôles du formulaire et si celui-ci porte un nom correspondant à une ligne (ex. : ccPosA pour case à cocher PosA) et que cette case est cochée (le contrôle vaut -1), alors la fonction renvoie True. Si aucune case de ce type n'est cochée, alors la fonction renvoie False.

V-B. Le clic sur le bouton « Load »

 
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
Option Compare Database
Option Explicit

Dim sMachine As String



Private Sub btLoad_Click()
  Dim ctl As Control
  Dim i As Integer
  Dim sSql As String
  Dim sDebut As Variant
  Dim sFin As Variant
  Dim q As QueryDef

  
  '-----------------------------------
  'vérifier la cohérence de la demande
  '-----------------------------------
  
    'Une date de départ ou une date de pièce doit être spécifiée
    If IsNull(Me.txtDateDepart) + IsNull(Me.txtDateNum) <> -1 Then
        MsgBox "Vous devez choisir soit par date soit par pièces.", vbCritical
        Exit Sub
    End If
    
    'Si recherche par pièces, alors les 3 paramètres doivent être spécifiés
    If IsNull(Me.txtDateNum) = False Then
        If IsNull(Me.txtNumDepart) + IsNull(Me.txtNumArrivee) <> 0 Then
            MsgBox "Un des paramètres manque pour la recherche par pièces.", vbCritical
            Exit Sub
        End If
    End If
    
    'Une machine doit être sélectionnée
    If Me.CxMachine = 0 Then
        MsgBox "Vous devez choisir un carrousel", vbCritical
        Exit Sub
    End If
    
    'Si Thermocouple ou Burners est sélectionné, au moins une position doit l'être également
     For Each ctl In Me.Controls
       If ctl.Name Like "ccBur*" Or ctl.Name Like "ccThe*" Then
            If ctl = -1 Then
                If LignePresente("ccPos") = False Then
                    MsgBox "Vous avez choisi Burners ou Thermocouple => vous devez choisir au moins une position.", vbCritical
                    Exit Sub
                End If
            End If
       End If
     Next ctl
   
    'Si la demande porte sur une plage de N°, le départ et l'arrivée doivent être mentionnés ensemble
    If IsNull(Me.txtNumDepart) And Not IsNull(Me.txtNumArrivee) Then
        MsgBox "Le numéro de pièce de départ manque.", vbCritical
        Exit Sub
    End If
    If Not IsNull(Me.txtNumDepart) And IsNull(Me.txtNumArrivee) Then
        MsgBox "Le numéro de pièce d'arrivée manque.", vbCritical
        Exit Sub
    End If
    If Not IsNull(Me.txtNumDepart) And Me.txtNumArrivee < Me.txtNumDepart Then
        MsgBox "Les numéros de pièce sont incohérents.", vbCritical
        Exit Sub
    End If
    
    'Si la demande porte sur une plage de N°, au moins une position doit être sélectionnée
    If Not IsNull(Me.txtNumDepart) And LignePresente("ccPos") = False Then
        MsgBox "Pour une plage de N°, une position doit être mentionnée.", vbCritical
        Exit Sub
    End If
  
  
  '--------------------
  'Charger les fichiers
  '--------------------
    DoCmd.SetWarnings False
    'Purger tInput
    DoCmd.RunSQL "DELETE Variable FROM tInput;"
     
    'Ligne Position
    If LignePresente("ccPos") = True Then
        'Charger Compteur* si plage de N° de pièces
        If Not IsNull(Me.txtNumDepart) Then
          For i = 65 To 70
            '1° on charge les compteurs
            If Me("ccPos" & Chr(i)) = True Then
                Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Counter " & Chr(i))
            End If
          Next i
            '2° seuls les enregistrements de la date saisie et avec [Valeur]<> 0 nous intéressent
            DoCmd.RunSQL "DELETE Valeur FROM tInput WHERE Valeur=0;"
               'N.B. on éliminera ceux d'autres dates plus bas dans ce code (quand Temps aura été formaté)
        End If
    End If

   'Ligne Thermocouple
   If LignePresente("ccThe") = True Then
       '1° charger Les Temperature* des positions
       For i = 65 To 70
            If Me("ccPos" & Chr(i)) = True Then
                Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Temperature " & Chr(i))
            End If
       Next i
       '2° éliminer les enregistrements de type B?_TEMPER_TCn pour les TCn non cochés
       For i = 1 To 8
         If Me("ccThe" & i) = False Then
             DoCmd.RunSQL "DELETE Variable FROM tInput WHERE Variable Like ""B?_TEMPER_TC" & i & """;"
         End If
       Next i
   End If
   
   'Ligne Furnace
   'Charger les fichiers Temperature Furnance n
   If Me.ccFur1 = True Then
       Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Temperature Furnance 1")
   End If
   If Me.ccFur2 = True Then
       Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Temperature Furnance 2")
   End If
   
   'Ligne Burners
   If Me.ccBurH = True Or Me.ccBurL = True Then
       '1° charger les fichiers Logs Burners correspondant aux positions choisies
       For i = 65 To 70 'chr(65) = A
         If Me("ccPos" & Chr(i)) = True Then
               Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Logs Burners " & Chr(i))
           End If
       Next i
       '2° ne retenir que les valeurs 100 pour low flame et 200 pour high flame
       sSql = "DELETE tInput.tImputPK, tInput.Variable " _
                 & "FROM tInput " _
                    & "WHERE (((tInput.tImputPK) " _
                       & "Not In (SELECT tImputPK FROM tInput " _
                          & "WHERE ((Variable Like ""*_position_burner_low_flame"") " _
                                 & "AND (Valeur=100)) " _
                              & "OR ((Variable Like ""*_position_burner_high_flame"") " _
                                 & "AND (Valeur=200));)) " _
                       & "AND ((tInput.Variable) Like ""BURNERS_FLAME\?_position_burner_*""));"
       DoCmd.RunSQL sSql
       '3° supprimer Flame non choisies
       If Me.ccBurH = False Then
             DoCmd.RunSQL "DELETE Variable FROM tInput WHERE Variable Like ""*_position_burner_high_flame"";"
       End If
       If Me.ccBurL = False Then
             DoCmd.RunSQL "DELETE Variable FROM tInput WHERE Variable Like ""*_position_burner_low_flame"";"
       End If
   End If

   'Ligne Outside_Burner
   If LignePresente("ccOut") = True Then
       '1° Charger tout le répertoire Outside_Burner
       Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Outside_Burner")
       '2° éliminer les enregistrements de type Outside_Burner_TCn pour les TCn non cochés
       For i = 1 To 8
         If Me("ccOut" & i) = False Then
             DoCmd.RunSQL "DELETE Variable FROM tInput WHERE Variable Like ""Outside_Burner_TC" & i & """;"
         End If
       Next i
   End If
   
   'Ligne Tilting
   If LignePresente("ccTil") Then
       '1° charger les répertoires Tilting_lettre correspondant
       For i = 65 To 70 'chr(65) = A
         If Me("ccTil" & Chr(i)) = True Then
               Call ImportCSV(CurrentProject.Path & "\FichiersCsv\" & sMachine & "\Tilting_" & Chr(i))
           End If
            
       Next i
   End If

  'Toilettage final
  'Supprimer les enregistrements Like "$RT*"
  DoCmd.RunSQL "DELETE Variable FROM tInput WHERE Variable Like ""$RT*"";"
  'Formater la donnée temps
  DoCmd.RunSQL "UPDATE tInput SET TempsFormate = Replace([temps],""."",""/"");"
  
  '-----------------------------------------
  'Construire ce qui sera exporté vers Excel
  '-----------------------------------------
  
  'Déterminer le laps de temps (Début et fin)
  If IsNull(Me.txtNumDepart) Then
      sDebut = "#" & Format([Forms]![fCommande]![txtDateDepart], "mm/dd/yy") & " " _
                            & Nz([Forms]![fCommande]![txtHeureDepart], "00:00:00") & "#"

      sFin = "#" & Format([Forms]![fCommande]![TxtDateArrivee], "mm/dd/yy") & " " _
                            & Nz([Forms]![fCommande]![txtHeureArrivee], "23:59:59") & "#"
    Else 'donc si l'utilisateur a mentionné des N° de pièces
      'D'abord éliminer les COUNTER_* d'une autre date que celle mentionnée
      DoCmd.RunSQL "DELETE Variable, Format([TempsFormate],""mm/dd/yy"") AS Expr1 " _
                       & "FROM tInput " _
                        & "WHERE Variable Like ""COUNTER_*""" _
                         & "AND Format([TempsFormate],""mm/dd/yy"") " _
                                  & " <>Format([Forms]![fCommande]![txtDateNum],""mm/dd/yy"");"
      'Trouver le laps de temps entre les deux pièces
      sDebut = Format _
         (DLookup("TempsFormate", "tinput", "Variable like ""COUNTER_*"" and valeur =" & Me.txtNumDepart), _
         "mm/dd/yy hh:mm:ss")
      If Len(sDebut) = 0 Then
          MsgBox "Le N° de pièce Début n'a pas été trouvé dans la sélection", vbCritical
          Exit Sub
        Else
          sDebut = "#" & sDebut & "#"
      End If
      sFin = Format _
         (DLookup("TempsFormate", "tinput", "Variable like ""COUNTER_*"" and valeur =" & Me.txtNumArrivee), _
         "mm/dd/yy hh:mm:ss")
      If Len(sFin) = 0 Then
          MsgBox "Le N° de pièce Fin n'a pas été trouvé dans la sélection", vbCritical
          Exit Sub
        Else
          sFin = "#" & sFin & "#"
      End If
  End If
  
  'Construire la requête à exporter
  sSql = "SELECT tInput.tImputPK, tInput.Variable, tInput.Valeur, " _
               & "tInput.TempsFormate AS [Date], Format([Tempsformate],""hh:mm:ss"") AS Heure " _
                & "FROM tInput " _
                 & "WHERE (((tInput.TempsFormate)>=" & sDebut & " And (tInput.TempsFormate)<=" & sFin & "));"
  Set q = CurrentDb.QueryDefs("rOutputExcel")
  q.SQL = sSql
  Set q = Nothing
  
  'Export vers FromAccess.xls
  Kill CurrentProject.Path & "\FromAccess.xls"
  DoCmd.TransferSpreadsheet acExport, , "rOutputExcel", CurrentProject.Path & "\FromAccess.xls", False
  
  'Ajout de la capture d'écran
  Call AltPrintScreen
  Call AjoutPrintScreen

  'Message de bonne arrivée
  MsgBox DCount("*", "rOutputExcel") & " enregistrements ont été inclus dans FromAccess.xls", vbInformation
  'Purger tInput
  DoCmd.RunSQL "DELETE Variable FROM tInput;"
  DoCmd.SetWarnings True
End Sub

Remarquez que la variable sMachine est définie en tête du module de classe du formulaire.

Image non disponible

Elle est donc visible tout le temps que le formulaire reste ouvert.

Le code se compose de trois parties :

Image non disponible

V-B-1. Vérifier la cohérence de la demande

Instructions de 21 à 71.

Même si le VBA ne vous est pas (encore) familier, les commentaires inclus dans le code sont suffisamment explicites pour que vous « sentiez » ce qui s'y passe.

Quelques compléments

IsNull(Me.NomUnControle) vaut -1 si le contrôle est Null et 0 si le champ est complété .. 

Me.NomCase vaut -1 si la case est cochée et 0 si elle ne l'est pas.

V-B-2. Charger les fichiers

Instructions de 77 à 177.

Ici aussi, les commentaires insérés dans le code devraient aider votre compréhension.

Quelques compléments

  • La fonction Chr(Nombre) renvoie le caractère ASCII qui correspond au nombre indiqué.

Par exemple :

 
Sélectionnez
       For i = 65 To 70 
          Debug.print Chr(i)) 
       Next i

affichera successivement A, B, C, D, E et F dans la fenêtre d'exécution.

  • À beaucoup d'endroits dans le code, on exécute des requêtes créées à la volée. Si vous voulez les visualiser avec l'interface graphique, copier le SQL dans une requête de test.
    Pour vous familiariser avec cette technique, voyez ce tutoriel Initiation - Débogage : requêtes écrites par VBA de Charles A (cafeine) et singulièrement, le chapitre V.
    Si vous récupérez le SQL particulièrement complexe des instructions 131 à 139 (en ajoutant une instruction Debug.print sSql entre la 139 et la 140) et que vous le collez dans une requête, vous obtiendrez ceci :
    Image non disponible
Image non disponible

V-B-3. Construire la requête pour exporter vers Excel

Ce sont les instructions 183-fin.

V-B-3-a. On commence par déterminer l'instant de début et l'instant de fin des enregistrements à exporter

De deux choses, l'une

- ou bien l'utilisateur a choisi de limiter en encodant les deux instants :

Image non disponible

- ou bien, il a spécifié une date et deux numéros de pièce pour exprimer l'intervalle :

Image non disponible

S'il a donné les deux instants

Image non disponible

on garnit deux variables sDebut et sFin avec le contenu des champs txtDateDepart/txtHeureDepart et txtDateArrivee/txtHeureArrivee du formulaire.
Si txtHeureDepart et/ou txtHeureArrivée sont restées Null, on les remplace respectivement par 00:00:00 et 23:59:59.

S'il a donné des numéros de pièces

On commence par éliminer tous les enregistrements des compteurs qui ne correspondent pas à la date donnée :

Image non disponible

On cherche ensuite l'instant qui correspond à la première pièce :

Image non disponible

S'il s'avère que l'utilisateur a renseigné une pièce non présente dans les enregistrements importés, un message d'alerte est affiché et le processus s'interrompt.

Idem mutatis mutandis pour la seconde pièce mentionnée :

Image non disponible
V-B-3-b. On modifie à la volée le SQL de la requête « rOutputExcel » 
Image non disponible

V-B-4. Exporter vers Excel, émettre un message de bonne fin et purger tInput

Image non disponible

L'instruction 232 provoque la capture d'écran de la fenêtre Access en cours, donc du formulaire fCommande avec les cases cochées. (L'image est donc logée dans le presse-papier.)

L'instruction 233 appelle la fonction AjoutPrintScreen décrite au paragraphe suivant.

VI. Une fonction pour prendre une capture de la fenêtre ACCESS

Ces quelques lignes de code ont été trouvées sur internet à cette adresse.

Il suffit de les copier-coller telles quelles dans un module (par exemple : « mCaptureEcran »).

 
Sélectionnez
Option Compare Database
Option Explicit

'http://word.mvps.org/faqs/macrosvba/PrtSc.htm

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
   bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Sub AltPrintScreen()
     keybd_event VK_MENU, 0, 0, 0
     keybd_event VK_SNAPSHOT, 0, 0, 0
     keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
     keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End Sub

Si vous lancez l'instruction Call AltPrintScreen, l'image de la fenêtre ACCESS est capturée et logée dans le presse-papier.

VII. Une fonction pour insérer l'image capturée dans le fichier Excel

 
Sélectionnez
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Public Sub AjoutPrintScreen()
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
   
    ' Initialiser les variables
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\FromAccess.xls")
   
    ' Ajouter une feuille de calcul nommée Choices
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Choices"
   
    ' Coller l'image dans la 1re cellule
    xlSheet.Cells(1, 1).Select
    xlApp.ActiveSheet.Paste
   
    ' Fermeture
    xlBook.Close (True)
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
   
End Sub

Explication du code

2-3 : la définition de ces variables implique d'ajouter la bibliothèque Microsoft Excel xx.x Object Library au projet

Image non disponible

Les commentaires inclus dans le code devraient vous permettre de comprendre ce qui s'y passe.

VIII. Téléchargement

L'application test (Access2000) peut être téléchargée ici

IX. Remerciements

Ma gratitude à :
ludi42 d'avoir expliqué en détail l'aspect métier de cet article ;

jimbolion et madefemere pour leurs contributions pendant la mise au point.

milkoseck pour la relecture orthographique.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2015 Claude Leloup. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.