Exporter plusieurs requêtes pour en faire des tableaux croisés dynamique

**laminosd** · 25/11/2014, 12h44

Bonjour tout le monde,

Je me sers du produit suivant (programme trouvé sur la rubrique Tutoriel) pour exporter une requête vers un ficheir Excel, et cela marche très bien. Je souhaite cependant faire en sorte qu'il m'exporte 4 requêtes sur un même fichier Excel mais dans quatres onglets distincts(en les titrant éventuellement) et qu'en cas de nouvelle exportation la récente n'écrase pas l'ancienne.
Merci par avance de votre aide qui m'ait très précieusecar je bloque vraiment sur ce point depuis quelques temps.

Voici le code du tutoriel pour l'exportation:

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
 
Function TransfertExcelAutomation()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim I As Long, J As Long
Dim t0 As Long, t1 As Long
t0 = Timer
Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("Maquette_TOP", dbOpenSnapshot)
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutor"
 
' le titre
' écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Structure des donées"
' les entetes
' .Fields(Index).Name renvoie le nom du champ
For J = 0 To rec.Fields.Count - 1
xlSheet.Cells(3, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(3, J + 1)
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
' recopie des données à partir de la ligne 3
I = 4
Do While Not rec.EOF
For J = 0 To rec.Fields.Count - 1
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText) nous insérons "'" pour
' qu'il soit reconnu par Excel comme du Texte
If rec.Fields(J).Type = dbText Then
xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
Else
xlSheet.Cells(I, J + 1) = rec.Fields(J)
End If
Next J
I = I + 1
rec.MoveNext
Loop
 
' code de fermeture et libération des objets
xlBook.SaveAs "C:\Users\Moi\Desktop\Nouveau dossier\Export.xlsx"
xlApp.Quit
rec.Close
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
t1 = Timer
Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
 
 
End Function

j'ai fait un sous programme:

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
 
Private Sub ExportFeuille(xlSheet As Excel.Worksheet, rec As ADODB.Recordset)
'les entetes
' .Fields(Index).Name renvoie le nom du champ
For J = 0 To rec.Fields.Count - 1
xlSheet.Cells(3, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(3, J + 1)
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.HorizontalAlignment = xlCenter
End With
Next J
' recopie des données à partir de la ligne 3
I = 4
Do While Not rec.EOF
For J = 0 To rec.Fields.Count - 1
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText) nous insérons "'" pour
' qu'il soit reconnu par Excel comme du Texte
If rec.Fields(J).Type = dbText Then
xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
Else
xlSheet.Cells(I, J + 1) = rec.Fields(J)
End If
Next J
I = I + 1
rec.MoveNext
Loop
 
End Sub

et le programme principale:

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
 
Function TransfertExcelAutomation1(ByRef config() As Action)
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
 
Dim I As Long, J As Long
Dim t0 As Long, t1 As Long
t0 = Timer
Dim rec1, rec2, rec3, rec4 As Recordset
 
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
   Set xlSheet = xlBook.Worksheets.Add
   xlSheet.Name = "Tutor1"
   Set rec1 = CurrentDb.OpenRecordset("REJET_TRANCHES", dbOpenSnapshot)
   ' le titre1
   ' écriture dans la cellule de ligne 1 et de colonne 1
   xlSheet.Cells(1, 1) = "Première Structure des donées"
   '''''''''''''''''
   '''''''''''''''''
             Set xlSheet = xlBook.Worksheets.Add
             xlSheet.Name = "Tutor2"
             Set rec2 = CurrentDb.OpenRecordset("REJET_SEM", dbOpenSnapshot)
   ' le titre2
   ' écriture dans la cellule de ligne 1 et de colonne 1
             xlSheet.Cells(1, 1) = "Deuxième Structure des donées"
   '''''''''''''''''
                 Set xlSheet = xlBook.Worksheets.Add
                 xlSheet.Name = "Tutor3"
                 Set rec3 = CurrentDb.OpenRecordset("REJET_MOIS", dbOpenSnapshot)
   ' le titre3
   ' écriture dans la cellule de ligne 1 et de colonne 1
                 xlSheet.Cells(1, 1) = " Troisième Structure des donées"
   '''''''''''''''''
                    Set xlSheet = xlBook.Worksheets.Add
                    xlSheet.Name = "Tutor4"
                    Set rec4 = CurrentDb.OpenRecordset("TRANCHES_MOIS", dbOpenSnapshot)
   ' le titre4
   ' écriture dans la cellule de ligne 1 et de colonne 1
 
                    xlSheet.Cells(1, 1) = "Quatrième Structure des donées"
 
   '''''''''''''''''
   ''''''''''''''''''
 
 
Call ExportFeuille(xlSheet1, rec1)
Call ExportFeuille(xlSheet2, rec2)
Call ExportFeuille(xlSheet3, rec3)
Call ExportFeuille(xlSheet4, rec4)
 
 
 
'Call ExportFeuille(Tutor1, rec1)
'Call ExportFeuille(Tutor2, rec2)
'Call ExportFeuille(Tutor3, rec3)
'Call ExportFeuille(Tutor4, rec4)
 
 
 
 
' code de fermeture et libération des objets
 
xlBook.SaveAs "C:\Users\Moi\Desktop\Nouveau dossier\Export.xlsx"
xlApp.Quit
 
 
rec1.Close
rec2.Close
rec3.Close
rec4.Close
 
 
Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
t1 = Timer
Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
 
 
 
End Function

Au finish j'ai l'erreur suivant

Type d'argument ByRef incompatible

Aidez moi SVP C'EST URGENT

**pyloupylou** · 27/11/2014, 14h27

c'est quoi ton paramètre config() , il est déclaré quelque part ?

sinon je vois que tu fais une boucle pour exporter tes résultats, je préfère le faire en 1 fois
ci joint petit exemple

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
'  
' exporte un query
' obook : classeur excel
' sheetname : nom onglet destination ( doit exister dans le classeur ) sinon il faut adapter le code pour tester l'existence et le créer au besoin
' nomquery : peut être soit un select ou le nom d'une requête pré-enregistrée
' ------------------------------------------------------------------------------
' usage : call exporte_rqte(monclasseurexcel,"Feuil1",""select * from matable")
'
 Function exporte_rqte(ByRef obook As Excel.Workbook, ByVal sheetname As String, ByVal nomquery As String)
            On Error GoTo exporte_rqte_err
            Dim myrst_explor As Recordset
            Set myrst_explor = db.OpenRecordset(nomquery)
            ' on inscrit les colonnes de la requete
            For i = 0 To myrst_explor.Fields().Count - 1
                obook.Sheets(sheetname).Cells(1, i + 1).Value = myrst_explor.Fields(i).Name
            Next
            ' on recopie les données
            obook.ActiveSheet.Range("A2").CopyFromRecordset myrst_explor
            ' on ferme le recordset
            myrst_explor.Close
            Set myrst_explor = Nothing
GoTo exporte_rqte_fin
exporte_rqte_err:
       MsgBox "attention erreur détectée ! " & vbCrLf & "Numéro: " & Err.Number & "-" & Err.desccription
exporte_rqte_fin:
End Function
'
' ici c'est l'essai que j'ai fait pour lancer la fonction
'
'
Sub essai_export()
Dim oXL As Excel.Application
Dim obook As Excel.Workbook
Set oXL = New Excel.Application
oXL.Visible = True
Set obook = oXL.Workbooks.Add
Call exporte_rqte(obook, "Feuil1", "select * from matable")
'attention excel n'est pas fermé ici
End Sub

**laminosd** · 27/11/2014, 14h47

Envoyé par pyloupylou

c'est quoi ton paramètre config() , il est déclaré quelque part ?

sinon je vois que tu fais une boucle pour exporter tes résultats, je préfère le faire en 1 fois
ci joint petit exemple

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
'  
' exporte un query
' obook : classeur excel
' sheetname : nom onglet destination ( doit exister dans le classeur ) sinon il faut adapter le code pour tester l'existence et le créer au besoin
' nomquery : peut être soit un select ou le nom d'une requête pré-enregistrée
' ------------------------------------------------------------------------------
' usage : call exporte_rqte(monclasseurexcel,"Feuil1",""select * from matable")
'
 Function exporte_rqte(ByRef obook As Excel.Workbook, ByVal sheetname As String, ByVal nomquery As String)
            On Error GoTo exporte_rqte_err
            Dim myrst_explor As Recordset
            Set myrst_explor = db.OpenRecordset(nomquery)
            ' on inscrit les colonnes de la requete
            For i = 0 To myrst_explor.Fields().Count - 1
                obook.Sheets(sheetname).Cells(1, i + 1).Value = myrst_explor.Fields(i).Name
            Next
            ' on recopie les données
            obook.ActiveSheet.Range("A2").CopyFromRecordset myrst_explor
            ' on ferme le recordset
            myrst_explor.Close
            Set myrst_explor = Nothing
GoTo exporte_rqte_fin
exporte_rqte_err:
       MsgBox "attention erreur détectée ! " & vbCrLf & "Numéro: " & Err.Number & "-" & Err.desccription
exporte_rqte_fin:
End Function
'
' ici c'est l'essai que j'ai fait pour lancer la fonction
'
'
Sub essai_export()
Dim oXL As Excel.Application
Dim obook As Excel.Workbook
Set oXL = New Excel.Application
oXL.Visible = True
Set obook = oXL.Workbooks.Add
Call exporte_rqte(obook, "Feuil1", "select * from matable")
'attention excel n'est pas fermé ici
End Sub

Bonjour merci pour ta reponse l'argument c'atait juste pour eviter le message d'erreur sinon j'ai simplifié mon code j'ai ceci:

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
 
 
 
Sub tac()
 
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "REJET_TRANCHES_SEMAINE", "D:\MINA\Export1.xls", True, "tac"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "REJET_TRANCHES_MOIS", "D:\MINA\Export1.xls", True, "tac"
 
 
 
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "REJETLCA_MOIS", "D:\MINA\Export.xls", True, "REJETLCA_MOIS"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "LCA_OK_MOIS", "D:\MINA\Export.xls", True, "LCA_OK_MOIS"
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "REJET_TRANCHES_SEMAINE", "sFichier ", True, "REJET"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "REJET_TRANCHES_MOIS", "sFichier ", True, "test"
 
 
End Sub

Ce code marche bien mais le but c'est d'avoir toutes ces requêtes dans une même feuille mais ici c'est pas le cas

**pyloupylou** · 27/11/2014, 15h08

j'imagine que donc les requêtes ont exactement la même structure

si c'est le cas avant d'exporter tes données, il faut savoir combien de lignes sont exportées

en utilisant la routine que je t'ai fourni, il suffit de positionner un recordcount ce qui donnerait ceci

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
'  
' exporte un query
' obook : classeur excel
' sheetname : nom onglet destination ( doit exister dans le classeur ) sinon il faut adapter le code pour tester l'existence et le créer au besoin
' nomquery : peut être soit un select ou le nom d'une requête pré-enregistrée
' ------------------------------------------------------------------------------
' usage : call exporte_rqte(monclasseurexcel,"Feuil1",""select * from matable", byref ligne_depart as integer )
'
 Function exporte_rqte(ByRef obook As Excel.Workbook, ByVal sheetname As String, ByVal nomquery As String)
            On Error GoTo exporte_rqte_err
            Dim myrst_explor As Recordset
            dim nbligne as integer 
            Set myrst_explor = db.OpenRecordset(nomquery)
            if not myrst_explor.eof() then
                  ' on regarde combien de ligne on a récupéré
                  nbligne= myrst_explor.recordcount 
                        ' on inscrit les colonnes de la requete
                        ' si la ligne de départ est à 0 '
                  if ligne_depart=0 then 
                      For i = 0 To myrst_explor.Fields().Count - 1
                          obook.Sheets(sheetname).Cells(1, i + 1).Value = myrst_explor.Fields(i).Name
                      Next
                      ligne_depart=1
                  endif
                  ' on recopie les données
                  obook.ActiveSheet.Range("A" & ligne_depart+1 ).CopyFromRecordset myrst_explor
                  ' on ferme le recordset
                  ' on actualise ligne_depart
                  ligne_depart=ligne_depart+nbligne 
            endif
            myrst_explor.Close
            Set myrst_explor = Nothing
GoTo exporte_rqte_fin
exporte_rqte_err:
       MsgBox "attention erreur détectée ! " & vbCrLf & "Numéro: " & Err.Number & "-" & Err.desccription
exporte_rqte_fin:
End Function
'
' ici c'est l'essai que j'ai fait pour lancer la fonction
'
'
Sub essai_export()
Dim oXL As Excel.Application
Dim obook As Excel.Workbook
Set oXL = New Excel.Application
oXL.Visible = True
Set obook = oXL.Workbooks.Add
dim position as integer
' ici position va s'actualiser à chaque itération'
position=0
Call exporte_rqte(obook, "Feuil1", "select * from matable",position)
Call exporte_rqte(obook, "Feuil1", "select * from matable2",position)
 
'attention excel n'est pas fermé ici
End Sub

**laminosd** · 27/11/2014, 15h47

mes requêtes sont differentes elles ont le même nombre de colonnes mais pas même nombre de lignes voici leurs codes:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
SELECT DISTINCT Count(REJET_V2.transactionReference) AS NB_Transactions, Sum([sourceAmount]/100) AS Expr1, SEMAINE2014.Semaine
FROM REJET_V2, SEMAINE2014
WHERE (((REJET_V2.merchantId) Like "*05") AND (([sourceAmount]/100)>=75) AND ((REJET_V2.valueDate)=[SEMAINE2014].[Date]))
GROUP BY SEMAINE2014.Semaine
ORDER BY SEMAINE2014.Semaine;
 
 
SELECT Month([transactionDateTime]) AS Mois, Count(SIPS_12_V2.transactionReference) AS NB, Sum([originAmount]/100) AS CA
FROM SIPS_12_V2
WHERE (((SIPS_12_V2.merchantId) Like '*05') AND ((SIPS_12_V2.transactionStatus) Not Like "refused"))
GROUP BY Month([transactionDateTime])
HAVING (((Month([transactionDateTime]))>4));

**pyloupylou** · 27/11/2014, 16h03

oui, et alors.... c'est normalement géré

Code :

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

1
2
3
4
5
 
' ici position va s'actualiser à chaque itération'
position=0
Call exporte_rqte(obook, "Feuil1", "select * from matable",position)
Call exporte_rqte(obook, "Feuil1", "select * from matable2",position)

au premier appel position est à zéro
à la fin de l'appel position aura été rempli et indiquera le denier numéro de ligne rempli ( si je ne me suis pas trompé

)
et sera passé en paramètre au deuxième appel et ainsi de suite

sinon si tu veux passer directement le sql en paramètre à la fonction fournie il te faut remplcer tes " (3 minuscule) par des '(4 minuscules)

mais reprenons:
tu veux enchaîner plusieurs requêtes vers une feuille excel pour pouvoir les exploiter via des TCD ?

je vois que la structure de tes requêtes sont différentes l'une de l'autre ( ce que je n'avais pas compris

)

ce que je te proposais est un export qui concatène les résultats , mais il me semble qu'en fait ce n'est pas ce que tu veux et j'ai plus l'impression que tu veux les résultats sur une même feuille mais sous forme de tableau séparés.
Si c'est le cas je te conseille d'adapter légerement la routine fournie pour réimplementer à chaque fois la ligne de titre ( à ce propos pense à mettre des noms significatifs pour tes colonnes )
Autre truc, aprés avoir coller tes données, je te conseille de créer un nom excel pour la plage remplie ( si tu ne connais pas cela permet de nommer une plage excel ( de mémoire c'est dan le le menu formules - gestionnaire de noms ))
l'intérêt c'est que tu peux ensuite adresser ces plages nommées avec tes TCD

**laminosd** · 27/11/2014, 16h12

Envoyé par laminosd

mes requêtes sont differentes elles ont le même nombre de colonnes mais pas même nombre de lignes voici leurs codes:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
SELECT DISTINCT Count(REJET_V2.transactionReference) AS NB_Transactions, Sum([sourceAmount]/100) AS Expr1, SEMAINE2014.Semaine
FROM REJET_V2, SEMAINE2014
WHERE (((REJET_V2.merchantId) Like "*05") AND (([sourceAmount]/100)>=75) AND ((REJET_V2.valueDate)=[SEMAINE2014].[Date]))
GROUP BY SEMAINE2014.Semaine
ORDER BY SEMAINE2014.Semaine;
 
 
SELECT Month([transactionDateTime]) AS Mois, Count(SIPS_12_V2.transactionReference) AS NB, Sum([originAmount]/100) AS CA
FROM SIPS_12_V2
WHERE (((SIPS_12_V2.merchantId) Like '*05') AND ((SIPS_12_V2.transactionStatus) Not Like "refused"))
GROUP BY Month([transactionDateTime])
HAVING (((Month([transactionDateTime]))>4));

stp tu p integrer mes requetes dans ton code j'arrive pas et je comprend pas tout ton code merci pour ton aide

Exporter plusieurs requêtes pour en faire des tableaux croisés dynamique

VBA Access

Discussions similaires

Partager

Partager