Piloter Excel depuis Access
bjr à tous, je veux piloter excel depuis access mais quand j'exécute mon code un msg erreur: objet requis apparais sur la ligne
Code:
1
2
| 'on récupère le nombre total de lignes
nbLignes = xlWks.Range("A" & Rows.Count).End(xlUp).Row |
Après une discussion dans le forum Access, j'ai eu conseille de me guider vers vous. Alors voici le code complet
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
| Option Compare Database
Sub COMPLET()
Dim xlApp As Object 'Est Excel
Dim xlBook As Object 'Est un classeur
Dim xlWks As Object 'Est une feuille
Dim xlRange As Variant 'Est une cellule
Dim FichierXl As String 'Est le chemin du fichier de sortie
Dim Libellé4, nbLignes, formuleETotalGeneral, formuleETotalMois, FinMois, DebMois, FinService
FichierXl = CurrentProject.Path & "\" & "Prebudget01" & Year(Now) & Month(Now) & Day(Now) & ".xlsx"
DoCmd.TransferSpreadsheet acExport, , "Origine", FichierXl
'Export des données de la requête en fichier Excel. La fonction False pour ne pas avoir les entêtes de colonnes _
ne fonctionne pas pour un export Excel.
Set xlApp = CreateObject("Excel.Application") 'Ouverture d'une nouvelle instance d'Excel
Set xlBook = xlApp.Workbooks.Open(FichierXl) 'Ouverture du fichier
Set xlWks = xlBook.ActiveSheet 'Activation de la feuille
'Set xlRange = xlWks.Range("A1:A65535") 'Création de la plage de cellules. 65535 stations possible (limite du programme Excel)
xlApp.DisplayAlerts = False
xlApp.ScreenUpdating = False
xlWks.Name = "NouveauNomDeLaFeuille" 'Renomme la feuille
'Libellé1 = "SERVICES CENTRAUX"
'Libellé2 = "SERVICES DÉCONCENTRÉS INTÉRIEUR"
'Libellé3 = "SERVICES DÉCONCENTRÉS CONAKRY"
Libellé4 = "TOTAL GENERAL"
'on récupère le nombre total de lignes
nbLignes = xlWks.Range("A" & Rows.Count).End(xlUp).Row
'on groupe l'ensemble
xlWks.Rows(2 & ":" & nbLignes).Group
'la formule pour le total général
formuleETotalGeneral = "=SOUS.TOTAL(9;E2" & ":E" & nbLignes & ")"
'on peut déjà placer le total général -Libelle, formule et étire
xlWks.Range("A" & nbLignes + 1) = Libellé4
xlWks.Range("E" & nbLignes + 1).FormulaLocal = formuleETotalGeneral
xlWks.Range("E" & nbLignes + 1 & ":I" & nbLignes + 1).FillRight
xlWks.Range("A" & nbLignes + 1 & ":I" & nbLignes + 1).Font.Bold = True
'on commence par séparer tous les mois
FinMois = nbLignes
For i = nbLignes To 1 Step -1
If xlWks.Range("A" & i) <> xlWks.Range("A" & i + 1) And xlWks.Range("A" & i + 1) <> "TOTAL GENERAL" Then
'Mise à jour de la ligne de début de mois
DebMois = i + 1
'on construit la formule
formuleETotalMois = "=SOUS.TOTAL(9;E" & DebMois & ":E" & FinMois & ")"
'on la place dans la cellule en fin de mois
xlWks.Rows(FinMois + 1).Insert
xlWks.Range("E" & FinMois + 1).FormulaLocal = formuleETotalMois
'on étire la formule jusqu'à la colonne I
xlWks.Range("E" & FinMois + 1 & ":I" & FinMois + 1).FillRight
'on place le label
xlWks.Range("A" & FinMois + 1) = "Total " & xlWks.Range("A" & FinMois)
'on groupe le mois, on merge et centre
xlWks.Rows(DebMois & ":" & FinMois).Group
'********************************************************
'groupement interne par service
FinService = FinMois
For j = FinMois To DebMois Step -1
While xlWks.Range("C" & j).Value = xlWks.Range("C" & j - 1).Value And xlWks.Range("A" & j).Value = xlWks.Range("A" & j - 1).Value
j = j - 1
If j = 0 Then Exit Sub
Wend
'on insère une ligne en fin de service
xlWks.Rows(FinService + 1).Insert
FinMois = FinMois + 1
'on colle la formule et on étire
xlWks.Range("E" & FinService + 1).FormulaLocal = "=SOUS.TOTAL(9;E" & j & ":E" & FinService & ")"
xlWks.Range("E" & FinService + 1 & ":I" & FinService + 1).FillRight
'Ajoute le nom du service en C avec TOTAL - en gras
xlWks.Range("C" & FinService + 1).Value = "TOTAL " & xlWks.Range("C" & FinService).Value
xlWks.Range("C" & FinService + 1 & ":I" & FinService + 1).Font.Bold = True
'Regroupe les lignes
xlWks.Rows(j & ":" & FinService).Group
xlWks.Range("C" & j & ":C" & FinService).Merge
'xlWks.Range("C" & j & ":C" & FinService).HorizontalAlignment = xlCenter
'xlWks.Range("C" & j & ":C" & FinService).VerticalAlignment = xlCenter
FinService = j - 1
Next j
xlWks.Range("A" & DebMois & ":A" & FinMois).Merge
'xlWks.Range("A" & DebMois & ":A" & FinMois).HorizontalAlignment = xlCenter
'xlWks.Range("A" & DebMois & ":A" & FinMois).VerticalAlignment = xlCenter
'********************************************************
FinMois = i
End If
Next i
xlWks.Activate 'Activation de la feuille1
xlApp.ScreenUpdating = True
xlApp.DisplayAlerts = True 'Le message d'enregistrement est réactivé
xlApp.Visible = False 'Excel est invisible
'xlRange.Cells(1, 1).Select 'Selection de la cellule A1
xlBook.Save
xlBook.Close True 'Fermer le fichier et l'enregistre sans message de confirmation dû à xlapp.DisplayAlerts=false
xlApp.Quit 'Fermerture d'excel
MsgBox "Terminer", vbInformation, "Excel"
Set xlRange = Nothing 'Effacement de la mémoire tampon de la cellule active
Set xlWks = Nothing 'Effacement de la mémoire tampon de la feuille active
Set xlBook = Nothing 'Effacement de la mémoire tampon du classeur actif
Set xlApp = Nothing 'Effacement de la mémoire tampon de l'instance Excel
End Sub |
Merci pour votre aide.
