Export Champ requete sur excel

Version imprimable

Bonjour a tous
j'ai un code qui m'exporte une requete access sur excel avec une mise en page, jusque la pas de probleme.Mais je voudrais recuperer un des champ de la requete pour faire la mise en page
la question est: comment selectioner un champ pour l'exporter dans excel
Le champ a expoter se nome SERIE
Le code

Code:

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
Private Sub Commande37_Click()
 
 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("BotteND", dbOpenSnapshot)
 
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutoriel"
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Production Parqueterie Botte Normal"
     xlSheet.Cells(12, 1) = "Production Parqueterie Botte Decametré"
      xlSheet.Cells(2, 2) = Serie
    xlSheet.Cells(1, 5) = Date
   With xlSheet.Cells(1, 5)
    .Interior.ColorIndex = 12
    .Font.Bold = True
    .Font.Size = 12
    End With
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(4, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(4, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
 
    With xlSheet.Cells(10, J + 1)
            .Interior.ColorIndex = 1
            .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 = 5
    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
    Set rec = CurrentDb.OpenRecordset("BotteDD", dbOpenSnapshot)
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(14, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(14, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
         With xlSheet.Cells(20, J + 1)
            .Interior.ColorIndex = 1
            .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 = 15
    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:\Feuille.xls"
    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 Sub

Merci d'avance

23/08/2006, 13h55
Muhad'hib

Salut,

Citation:

Envoyé par Renardo

la question est: comment selectioner un champ pour l'exporter dans excel
Le champ a expoter se nome SERIE

Peux tu préciser exactement ce que tu veux faire ?

Exporter le champ SERIE dans une autre feuille, dans la même feuille à une endroit donné ... ?

A+
23/08/2006, 14h03
Renardo

sur la meme feuille a la cellule (2, 1)

Ben tu as la solution dans ton code 8O

Tu déclare un recordset, tu fait une boucle du début à la fin de ton Rs en collant les données de ton champ dans le classeur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
 
Set Rs =  CurrentDb.OpenRecordset("le_nom_de_table_ou_de_requete", dbOpenSnapshot)
 
  I = 2
    Do While Not Rs.EOF
            If Rs.Fields("Serie").Type = dbText Then
                xlSheet.Cells(I, 1) = "'" & Rs.Fields("Serie")
 
            Else
                xlSheet.Cells(I, 1) = Rsc.Fields("Serie")
 
            End If
        I = I + 1
        Rs.MoveNext
    Loop

A+

23/08/2006, 14h55
Renardo

merci pour ton aide sa fonctione
autre petite question sait tu si on peut faire un calcul genre
xlSheet.Cells(1, 5) = cells(1, 3)+cells(1, 4)

Re,

Si c'est du numérique oui :
Code:

1 2 xlSheet.Cells(1, 5) = xlSheet.cells(1, 3)+xlSheet.cells(1, 4)
A+

23/08/2006, 16h25
Renardo

Excelent cela fonctionne
comme je vois que tu es un espere encore une petite question
peut on fusionner plusieur cellule a partir d'access
Exemple
fusionner la cellule (1, 3) et (1, 4)
merci pour ton aide

Re,

Ca doit être qqchose comme ça :
Code:

1 2 3 xlSheet.range(xlSheet.cells(1,3),xlSheet.cells(1,4)).MergeCells = true
Pour trouver le code VBA pour faire n'importe quelle manip sur Excel :

- Dans Excel commancer une nouvelle macro (outils/macros/nouvelle macro)
- Fait ta manip (ici fusionner tes celulles)
- Arrete ta macro (outils/macros/arreter l'enregistrement)
- Va dans l'éditeur VBA pour voir le code
- analyse le, comprend le et inspire t'en !

Dans ton cas la macro donne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Range("C1:D1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With
L'important de ce code est :
Code:

1 2 .MergeCells = True
ce qui fait :
Code:

1 2 3 Range("C1:D1").Select Selection.MergeCells = True
Comme il n'est pas nécessaire de faire truc.select puis selection.bidule = machin (comme Excel le fait en automatique) on fera directement truc.bidule = machin :
Code:

1 2 3 Range("C1:D1").MergeCells = True
Comme on est dans Acces et pas dans Excel ça donne :
Code:

1 2 xlSheet.Range("C1:D1").MergeCells = True
Mais comme je préfére la notation cells(,) qu'avec les coordonnées je garderais :
Code:

1 2 xlSheet.range(xlSheet.cells(1,3),xlSheet.cells(1,4)).MergeCells = true
Voila qui devrait t'aider pour toute autre manipulation d'objet Excel

A+

23/08/2006, 18h55
Renardo

Bravo et merci pour tes explications cela fonctionne je n'etait pas tres loing de la solution mais je ne mettais pas Cells devant Merge
merci encore