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
| Private Sub suCopieExcel()
On Error GoTo gestion_err:
Dim db As DAO.Database: Set db = CurrentDb
Dim rst As DAO.Recordset
Dim fld As Field
Dim strSQL As String
Dim i As Integer, j As Integer
Dim oApp As Object
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
'Ici c'est la rq en SQL, j'ai divisé par mois mais il est possible de faire autrement
' Les produits sont mis en ordre alphabétique pour être comme dans le fichier Excel
strSQL = "TRANSFORM Sum(T_Table.Argent) AS Argent " _
& "SELECT T_Table.Produit FROM T_Table " _
& "GROUP BY T_Table.Produit ORDER BY T_Table.Produit" _
& "PIVOT Format([Date_Cle],'mmm') In ('janv','févr','mars','avr','mai','juin','juil','août','sept','oct','nov','déc');"
'On ouvre un jeu d'enregistrement
Set rst = db.OpenRecordset(strSQL, 4, 512)
'On ouvre Excel et on récupère le fichier
Set oApp = CreateObject("excel.application")
Set oWkb = oApp.Workbooks.Open("Le_Chemin_Et_Nom_Du_Fichier_Excel_Complet")
oApp.Visible = True
Set oWSht = oWkb.Worksheets("Le_Nom_De_La_Feuille")
j = 2 'On commence à inscrire les données à la deuxième ligne
Do While rst.EOF = False
For Each fld In rst.Fields
If fld.OrdinalPosition <> 0 Then 'On ne saisi pas la première colonne qui est le nom du produit
i = fld.OrdinalPosition + 1
oWSht.cell(j, i) = fld.Value
End If
Next
rst.MoveNext
j = j + 1
Loop
'On libère les objets
rst.Close
Set rst = Nothing
Set db = Nothing
oWkb.Close saveChanges:=True
Set oWSht = Nothing
Set oWkb = Nothing
Set oApp = Nothing
Sortie:
Exit Sub
gestion_err:
MsgBox Err.Description & Chr(13) & "Erreur numéro: " & Err.Number & Chr(13) & "Dans la Sub suCopieExcel"
Resume Sortie
End Sub |
Partager