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 |
Partager