Automation Excel - Ouverture requete
bonjour,
j'ai récupéré le code pour faire une automation d'access à excel.
cependant je voudrais transférer mes données d'une requete et non d'une table.
mon projet est la réalisation d'une base gérant l'autoévaluation des compétences de personnes. les collaborateurs vont saisir une premiere fois leur autoévaluation dans une ligne de la table. une fois fini, cette ligne est dupliquée (toujours dans la meme table), puis un évaluateur passe pour modifier ce qu'il n'est pas d'accord puis valide. la requete a pour but d'isoler les deux lignes dupliquées (celle saisie par l'utilisateur puis celle par l'évaluateur) grâce à deux questions de filtrage.
Donc voilà dans le code ci dessous on arrive clairement à ouvrir une base au complet mais pas la requete. Donc je voudrais savoir quelles sont les modifications à faire.
Je suis débutant en access.
Pour ce qui est mise en page j'ai compris donc je me débrouillerais derrière.
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
| 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("Clients", 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) = "Export d'une table Access"
' les entetes
' .Fields(Index).Name renvoie le nom du champ
For J = 0 To rec.Fields.Count - 1
xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(2, 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 = 3
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 "D:\Temp\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 Function |
Merci pour vos réponses
