Discussion :

[moilou2]

Bonjour, j'exporte des données vers Excel avec la macro suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'======Bouton qui permet d'ouvrir les statistiques======
 
Private Sub cmdeStatistiques_click()
 
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
 
Dim sql As String, sqlSelect As String, sqlFrom As String
Dim oRst As DAO.Recordset
Dim odb As DAO.Database
 
Dim NbLigne As Long
Dim LigneTableur As Integer
 
Dim lPercent As Single
Dim oProgress As clProgress
Dim lCptIteration1 As Long
Dim lCptIteration2 As Long
Dim lString As String
 
On Error GoTo Gestion_Erreurs
 
GetAdresseGMAO
Set odb = CurrentDb
 
sql = " SELECT Count(*) FROM (SELECT Id_Intervention from tbl_Intervention) "
Set oRst = odb.OpenRecordset(sql, dbOpenDynaset)
If Not oRst.EOF() Then
    NbLigne = oRst.Fields(0).Value
End If
 
 
' Ouverture et initialisation du formulaire d'attente
Set oProgress = New clProgress
oProgress.ProgressMin = 1
oProgress.ProgressMax = NbLigne
oProgress.ProgressValue = 0
oProgress.GeneralInfo = "Veuillez patienter durant le traitement ... "
oProgress.AnimationTimer = 500 ' <== Lance l'animation
oProgress.Visible = True
 
 
'Définition de la méthode pour exporter vers Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(AdresseGmao + "Dossiers GMAO\Ecriture Access vers Excel\Statistiques Historique des pannes\Historique des pannes (stat).xls")
Set xlSheet = xlApp.Worksheets("Historique des pannes")
 
AppActivate Application.Name
 
'Export de l'historique
sqlSelect = "SELECT tbl_Intervention.Id_Intervention as [n°], tbl_Intervention.DateIntervention as [Date], (select tbl_Personnel.Identite from tbl_Intervenir INNER JOIN tbl_Personnel ON tbl_Intervenir.Id_Personnel = tbl_Personnel.Id_Personnel where tbl_Intervention.Id_Intervention = tbl_Intervenir.Id_Intervention) as [Technicien], (select  tbl_ligne.ligne from tbl_machine INNER JOIN tbl_Ligne on tbl_Ligne.Id_Ligne = tbl_Machine.Id_Ligne where tbl_Intervention.Id_Machine = tbl_Machine.Id_Machine) as [Ligne], tbl_Machine.Machine, tbl_Type.Type, tbl_Categorie.Categorie as [Nature], tbl_SousEnsemble.SousEnsemble as [Sous Ensemble], tbl_Element.Element, tbl_Intervention.Descriptif, tbl_Diagnostic.Diagnostic, tbl_DureeIntervention.DureeIntervention as [Durée Intervention], tbl_DureeArret.DureeArret as [Durée Arrêt]"
sqlFrom = " FROM tbl_DureeIntervention INNER JOIN (tbl_DureeArret INNER JOIN ((((((tbl_Intervention LEFT JOIN tbl_Type ON tbl_Intervention.Id_Type = tbl_Type.Id_Type) LEFT JOIN tbl_Categorie ON tbl_Intervention.Id_Categorie = tbl_Categorie.Id_Categorie) LEFT JOIN tbl_SousEnsemble ON tbl_Intervention.Id_SousEnsemble = tbl_SousEnsemble.Id_SousEnsemble) LEFT JOIN tbl_Element ON tbl_Intervention.Id_Element = tbl_Element.Id_Element) LEFT JOIN tbl_Diagnostic ON tbl_Intervention.Id_Diagnostic = tbl_Diagnostic.Id_Diagnostic) LEFT JOIN tbl_Machine ON tbl_Intervention.Id_Machine = tbl_Machine.Id_Machine) ON tbl_DureeArret.Id_DureeArret = tbl_Intervention.DureeArretMachine) ON tbl_DureeIntervention.Id_DureeIntervention = tbl_Intervention.DureeIntervention where tbl_Intervention.Id_Intervention <> 0 "
 
sql = sqlSelect + sqlFrom
sql = sql & " ORDER BY tbl_Intervention.DateIntervention"
 
Set oRst = odb.OpenRecordset(sql, dbOpenDynaset)
LigneTableur = 4
 
While Not oRst.EOF()
 
    xlSheet.Range("A" & LigneTableur & "").Value = oRst.Fields("Date").Value
    xlSheet.Range("B" & LigneTableur & "").Value = oRst.Fields("Technicien").Value
    xlSheet.Range("C" & LigneTableur & "").Value = oRst.Fields("Ligne").Value
    xlSheet.Range("D" & LigneTableur & "").Value = oRst.Fields("Machine").Value
    xlSheet.Range("E" & LigneTableur & "").Value = oRst.Fields("Type").Value
    xlSheet.Range("F" & LigneTableur & "").Value = oRst.Fields("Nature").Value
    xlSheet.Range("G" & LigneTableur & "").Value = oRst.Fields("Sous Ensemble").Value
    xlSheet.Range("H" & LigneTableur & "").Value = oRst.Fields("Element").Value
    xlSheet.Range("J" & LigneTableur & "").Value = oRst.Fields("Descriptif").Value
    xlSheet.Range("L" & LigneTableur & "").Value = oRst.Fields("Diagnostic").Value
    xlSheet.Range("M" & LigneTableur & "").Value = oRst.Fields("Durée Intervention").Value
    xlSheet.Range("N" & LigneTableur & "").Value = oRst.Fields("Durée Arrêt").Value
    LigneTableur = LigneTableur + 1
    oRst.MoveNext
 
    ' Met à jour la progression
    oProgress.ProgressValue = LigneTableur
    ' Met à jour l'étiquette
    oProgress.ProgressInfo = "Traitement en cours ... " & Format(oProgress.ProgressPercent, "00%")
    ' Repeint le formulaire
    oProgress.Repaint
 
Wend
 
' Fermeture du formulaire d'attente
Set oProgress = Nothing
 
AppActivate xlApp.Caption
 
Exit Sub
 
Gestion_Erreurs:
    If Err.Source = "clProgress" Then
        ' Puis on continue le traitement
        Resume Next
    Else
        MsgBox "Erreur dans le traitement n° " & Err.Number & ", " & Err.Description, vbCritical
    End If
    Set oProgress = Nothing
 
End Sub

Il m'exporte bien mes lignes mais arrivé à 5800 je crois, ça beug.

Ma question : Ya t-il une limite de téléchargement de données ou autre, pourquoi le telechargement s'arreterait?

[moilou2]

J'ai des précisions à apporter à mon problème car je viens de récuperer mon fichier.

D'une part : le message d'erreur est en pièce jointe

D'autre part, je réussi à exporter 5263 lignes avant l'apparition du beug. La ligne du code sur laquelle ça beug est la suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

oRst.MoveNext

Mais ce qui est bizard, c'est que une fois le beugue apparu, si je vais en mode débeugage et que j'appui sur continuer (Fleche verte), le reste de mes données se télécharge.

Je me demande donc si le "beug" ne viendrait pas d'un souci de capacité d'export des données vers Excel.

En vu de ces élements supplémentaires, pouvez vous essayer d'apporter des élements de réponse à mon souci?

Merci

[nico84]

Bonjour,

Au vu du message, est-ce qu'un petit compactage de base arrange les choses ?

Pour être cohérent avec les capacités d'excel et nbligne, ce serait bien de déclarer lignetableur comme long

2 points concernant la syntaxe excel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 & ""

ne sert à rien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range("A1").offset(lignetableur,0).value

donne-t-il de meilleurs résultats ?

Pour info : l'anglais bug (=vermine) a été francisé en bogue (=chataigne)

[moilou2]

Bonjour, non aucun résultat positif, est ce que cela peut venir d'autre chose?

[Muhad'hib]

Cela ne changera peut etre rien à ton problème, mais au lieu de faire une boucle sur la ligne pour copier une par une tes valeurs de champs; pourquoi ne pas copier ton recordset directement ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Set oRst = odb.OpenRecordset(sql, dbOpenDynaset)
LigneTableur = 4
 
xlSheet.cells(4,1).CopyFromRecordset oRst

Un gros inconvénient ... tu ne pourra plus utilisé les formulaire de classe de progression d'Arkham


J'avais proposé une fonction ici qui utilisait cette méthode. En fait au début j'avais fait comme toi, mais qq'un avait proposé une amélioration de mon code en me proposant la méthode copyfromrecordset que je ne connaissait pas.