Discussion :

[Renardo]

Bonjour tous le monde
j'ai une requete que j'exporte sur excel dans cette requete j'ai un champ nomé SERIE se que je voudrais faire s'est creer un onglet pour chaque serie
cela est il possible. Merci d'avance pour votre aide.
Mon code

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
Private Sub Commande3_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim FichierExcel As Excel.Workbook
Set db = CurrentDb
Set rst = db.OpenRecordset("Excel", dbOpenSnapshot)
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
 Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = ("Serie")
 
 
 
col = 1
 While Not rst.EOF
Row = 1
col = col + 1
xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(2, 25)).EntireColumn.AutoFit
xlSheet.Cells(2, 2) = Date
 
xlSheet.Cells(2, 1) = "Date:"
xlSheet.Cells(2, 5) = "Serie:"
xlSheet.Range(xlSheet.Cells(2, 2), xlSheet.Cells(2, 4)).MergeCells = True
xlSheet.Range(xlSheet.Cells(2, 6), xlSheet.Cells(2, 9)).MergeCells = True
xlSheet.Cells(Row, col).EntireColumn.AutoFit
xlSheet.Cells(5, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
   xlSheet.Cells(5, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(5, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(6, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
   xlSheet.Cells(6, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(6, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(7, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
   xlSheet.Cells(7, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(7, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(8, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
   xlSheet.Cells(8, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(8, col).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(9, col).Borders(xlEdgeBottom).LineStyle = xlContinuous
   xlSheet.Cells(9, col).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(9, col).Borders(xlEdgeTop).LineStyle = xlContinuous
 xlSheet.Cells(5, col) = Format(Now, "h:mm")
 xlSheet.Cells(2, 6) = rst.Fields("Serial")
xlSheet.Cells(5, 1) = "H"
xlSheet.Cells(5, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(6, 1) = rst.Fields("Choix.Choix1")
xlSheet.Cells(6, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(6, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(6, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
 xlSheet.Cells(7, 1) = rst.Fields("Choix.Choix2")
 xlSheet.Cells(7, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(7, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(7, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(8, 1) = rst.Fields("Choix.Choix3")
 
 xlSheet.Cells(8, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(8, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(8, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Cells(9, 1) = rst.Fields("Choix.Choix4")
 
 xlSheet.Cells(9, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(9, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Cells(9, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
 
 
Row = Row + 1
xlSheet.Cells(5, col) = rst.Fields(1)
Row = Row + 1
xlSheet.Cells(6, col) = rst.Fields(2)
Row = Row + 1
xlSheet.Cells(7, col) = rst.Fields(3)
Row = Row + 1
xlSheet.Cells(8, col) = rst.Fields(4)
Row = Row + 1
xlSheet.Cells(9, col) = rst.Fields(5)
Row = Row + 1
rst.MoveNext
Wend
' code de fermeture et libération des objets
    xlBook.SaveAs "c:\Sauvegarde\control1.xls"
    xlApp.Quit
 
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    End Sub

[cafeine]

Hello,

je ne comprends pas ... tu as pourtant le code pour faire ça dans ton code :

Code :

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

1
2
 Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = ("Serie")

Pourquoi ne pas répéter l'opération Worksheets.Add ?

[Renardo]

Avec se code j'obtien un onglet marquer Serie
alors que je souhaiterais qu'il marque la valeur du champ Serie par exemple
23-70 et si j'ai plusieur serie dans la requete qu'il me mette
Exemple:
Onglet 23-70
Onglet 23-100
Onglet 23-110
Voit tu se que je veux dire
Merci pour ton aide

[DMboup]

Il faut que parcours to recordsert pour avoir les autres séries.

Code :

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

1
2
3
4
5
6
7
8
 
Do Until rst.eof
 
Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = (rst("Serie"))
 
rst.MoveNext
Loop

[Renardo]

Merci beaucoup pour ton aide
Cela marche mais le petit probleme la meme Serie peut se retrouver plusieur fois sur la requete et la sa provoque une erreur
exemple
23-70
23-120
23-70
je voudrais que le 23-70 soit regroupe sur l'onglet 23-70
et le 23-120 sur l'onglet 23-120
Peut etre aura tu une idee ou peut etre quelqu'un d'autre
merci d'avance

[DMboup]

Transforme alors ton recordset

Code :

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

1
2
 
Set rst = db.OpenRecordset("Select Distinc Serie Frrom Excel ... ")

Quelque chose du genre.

[Renardo]

Merci pour pour ton aide mais j'ai encore quelque soucis
Pour les onglets cela fonctione le probleme est qu'il exporte juste le champ Serie les autres donnees ne sont plus exportes

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
Private Sub Commande4_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim FichierExcel As Excel.Workbook
Set db = CurrentDb
Set rst = db.OpenRecordset("Select Distinct Serial From Excel")
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
 Do Until rst.EOF 
Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = (rst("Serial"))
    xlSheet.Cells(2, 6) = rst.Fields("Serial")
    xlSheet.Cells(1, 2) = rst.Fields("date1")
    xlSheet.Cells(6, 1) = rst.Fields("Choix.Choix1")
 
    xlSheet.Cells(2, 1) = "Date:"
    xlSheet.Cells(5, 1) = "H"
rst.MoveNext
Loop
 
col = 1
Do While Not rst.EOF
Row = 1
col = col + 1
xlSheet.Cells(5, col) = rst.Fields(1)
Row = Row + 1
 
rst.MoveNext
Loop
 
 ' code de fermeture et libération des objets
    xlBook.SaveAs "c:\Sauvegarde\control1.xls"
    xlApp.Quit
 
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
End Sub

merci d'avance pour ton aide

[DMboup]

Qu'est ce qui t'empéches d'inclure les champs que tu veux dans la requête?

Code :

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

1
2
 
Set rst = db.OpenRecordset("Select Distinct Serial, Champ1, Champ2, ..; From Excel")

[Renardo]

Desoler mais j'ai encore un petit souci
comment faire maintenant pour exporter mes donnees dans le bonne onglet Serial

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
Private Sub Commande4_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim FichierExcel As Excel.Workbook
Set db = CurrentDb
 
Set rst = db.OpenRecordset("Select Distinct Serial,Date1,PR,RU,NA,IND,H From Excel")
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
 Do Until rst.EOF
 
 
Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = (rst("Serial"))
    xlSheet.Cells(2, 6) = rst.Fields("Serial")
    xlSheet.Cells(2, 2) = rst.Fields("date1")
    xlSheet.Cells(2, 1) = "Date:"
    xlSheet.Cells(1, 5) = "Heure"
    xlSheet.Range(xlSheet.Cells(5, 1), xlSheet.Cells(35, 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous
xlSheet.Range(xlSheet.Cells(5, 1), xlSheet.Cells(35, 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
xlSheet.Range(xlSheet.Cells(5, 1), xlSheet.Cells(35, 1)).Borders(xlEdgeTop).LineStyle = xlContinuous
xlSheet.Cells(6, 1) = rst.Fields("PR")
xlSheet.Range(xlSheet.Cells(5, 1), xlSheet.Cells(35, 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
 xlSheet.Cells(7, 1) = rst.Fields("RU")
xlSheet.Cells(6, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(5, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(7, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(8, 1) = rst.Fields("NA")
 xlSheet.Cells(8, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
xlSheet.Cells(9, 1) = rst.Fields("IND")
xlSheet.Cells(9, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
rst.MoveNext
Loop
Set rst = db.OpenRecordset("Excel", dbOpenSnapshot)
 
col = 1
While Not rst.EOF
Row = 1
col = col + 1
xlSheet.Cells(5, col) = rst.Fields(1)
Row = Row + 1
 
rst.MoveNext
Wend
 
 ' code de fermeture et libération des objets
    xlBook.SaveAs "c:\Sauvegarde\control1.xls"
    xlApp.Quit
 
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
End Sub

Actuelement les onglet sont bien cree mais toute les donnees son sur la meme feuille ( j'ai reduit le code pour avoir que le principal)
Merci pour ton aide et ta passiance.

[DMboup]

Je crois qu'il ya quelque chose comme

Code :

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

1
2
 
xlSheet("NomFeuille").Selected

cherche dans l'aide et remplacer NomFeuille par rst("Serial").

[Renardo]

Boujour et merci pour le temp que tu me consacre

Code :

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

xlSheet("feuille1").Selected

J'ai se message d'erreur
Propriete ou methode non geree par cet objet