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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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.