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
|
Public Function SendToSheet(ByVal rst As Recordset, ByVal xlSheet As Excel.Worksheet)
'---------------------------------------------------------------------------------------
'
'
' Copie les données dans un la feuille d'un fichier Excel
'---------------------------------------------------------------------------------------
Dim i As Long, j As Long
' les entetes
For j = 0 To rst.Fields.Count - 1
'On test pour voir s'il existe une propriété de type légende
If ExistProperty(rst.Fields(j).Properties, "caption") Then
'.Fields(Index).Properties("caption") renvoie la légende du champ
xlSheet.Cells(1, j + 1) = rst.Fields(j).Properties("caption")
'Sinon on utilise le nom du champ
Else
'.Fields(Index).Name renvoie le nom du champ
xlSheet.Cells(1, j + 1) = rst.Fields(j).Name
End If
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(1, 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 2
i = 2
Do While Not rst.EOF
For j = 0 To rst.Fields.Count - 1
xlSheet.Cells(i, j + 1) = rst.Fields(j)
Next j
i = i + 1
rst.MoveNext
Loop
'Dimensionnement automatique des lignes & colonnes
xlSheet.Columns.AutoFit
xlSheet.Rows.AutoFit
End Function |
