Discussion :

[kir4000]

Bonjour,

Un autre problème, j'aimerai envoyer un graphique contenu d'un classeur excel contenu dans un objet, vers un nouveau classeur excel, et le tout sans macro de (re)création du graphique.
Simple question : est-ce possible ? Sinon, je saurai me débrouiller, mais ça va quand même prendre un peu de temps.

Pour expliquer mon code, en amont, mon objet contient une feuille, alimentée par une requête (avec en tête), et une feuille graphe qui se met à jour (selon le nombre de séries, données sources etc...) par macro excel décrite et donc adapté au VBA Access lors de l'activation de l'enregistrement (form_current) du formulaire global.
Dans mon code ci-dessous, l'exportation des données de l'objet classeur vers le nouveau classeur fonctionne bien, avec la création d'une feuille graphique.

J'aimerais donc que tout cet objet soit envoyé directement dans un nouveau classeur, en conservant la mise en forme du graphe, et par bonheur sans retoucher à la sélection des données sources, séries etc...

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
Private Sub Flotte_Trainer_export_graphe_Click()
Dim appexcel As Excel.Application
Dim oWb1 As Excel.Workbook, oWb2 As Excel.Workbook
Dim oFeuille1 As Excel.Worksheet, oFeuille2 As Excel.Worksheet
Dim oGraph1 As Excel.Chart, oGraph2 As Excel.Chart
 
Set appexcel = CreateObject("Excel.Application")
    appexcel.Application.Visible = True
 
'Ouverture d'un fichier Excel
Set oWb1 = appexcel.Workbooks.Add
Set oWb2 = Forms.F_Pays.Flotte_fighter_graphe.Object
 
 
Set oFeuille1 = oWb1.Worksheets(1)
Set oFeuille2 = oWb2.Worksheets(1)
Set oGraph1 = oWb1.Charts.Add 'création d'une feuille graphe
Set oGraph2 = oWb2.Charts(1) 'là ça ne fait rien, la feuille graphique reste vide
 
oFeuille1.Range("a1:l100").Value = oFeuille2.Range("a1:l100").Value 'kopikol de mes données
'début de typage du graphe au cas il le faudra, mais je m'y prends mal je viens de commencer
'Set oGraph1.ChartType = oGraph2.ChartType
'Set oGraph1.ChartArea = oGraph2.ChartArea
 
'Désallocation mémoire
Set oFeuille1 = Nothing
Set oFeuille2 = Nothing
Set oWb1 = Nothing
Set oWb2 = Nothing
Set oGraph1 = Nothing
Set oGraph2 = Nothing
Set appexcel = Nothing
 
End Sub

[argyronet]

Bonjour,

Désolé pour les désagréments de déplacement mais le message prêtait à confusion...

Bref, si j'ai bien compris, le but est de copier graphique et données d'un classeur vers sun autre ?
Si c'est le cas, l'usage de méthode de copie de VBA issue de l'objet Excel doit répondre à ta demande.
Mais il est évident que cela requiert un peu de codage Automation, ce qui n'est pas forcément limpide pour tous...

Argy

[kir4000]

Rebonjour, merci d'avoir répondu !

Je viens d'écrire un gros pavé avec mon code et tout, et j'ai fermé la fenêtre...

Donc si je comprends bien, il faut impérativement recréer du VBA sur Access, qui créera le graph sur la feuille du nouveau classeur excel, à chaque export. Je précise que je n'utiliserai pas de fichier modèle xls car s'il est effacé par un user...

J'ai déjà une macro VBA de MAJ du graph dans l'objet access, mais pas encore de macro VBA de création de graph pour le nouveau classeur exporté.
Donc j'imagine que la copie de code VBA de MAJ ne fonctionnera dans mon cas.

J'ai bon ?

[argyronet]

Il y a quelque chose qui m'échappe
Tu dis que tu veux copier graphique et données d'un classeur (donc existant, je présume) et dans ton dernier message, tu dis qu'il peut être supprimé par un tier...

Essaye d'être un peu plus précis sur la démarche :

• Qu'est ce que tu as au départ et tu pars d'où (Données de table depuis un formulaire... ???)
• Que fait l'utilisateur dans tout ça ?
• Que doit-on obtenir à l'arrivée.
• Excel reste t-il ouvert ?
• Le classeur 2 existe t-il aussi ?

Là je pourrais te répondre...

Argy

[kir4000]

Bonjour !

Merci pour ta patience Je vais essayer d'être plus explicite.

Avant tout j'ai deux cas de figure : le premier est que je suis la méthode que j'ai commencé (export vers fichier vide), mais je crois que je vais suivre finalement l'export vers un modèle excel (.xlt).

D'abord je réponds à tes questions, et ensuite j'explique ce qu'il me reste à faire dans les deux cas de figure

• Qu'est ce que tu as au départ et tu pars d'où (Données de table depuis un formulaire... ???)

Je suis sur un formulaire Access basé sur une table pays, où est présent un objet OLE Excel indépendant contenant une feuille de données (Feuil1), et un graphe (Graph1, c'est le nom de la feuille-graphe) que l'on voit sur l'écran. L'objet est verrouillé, l'utilisateur ne peut y toucher.
Le graphe est déjà construit, il se rapporte aux données de la feuille. La feuille est alimenté en données par une requête combinant plusieurs tables avec un where=nomdel'enregistrementduformulaire (également clé primaire de la table pays).
A chaque changement d'enregistrement, la feuille de données puis le graphe sont MAJ par VBA (ça fonctionne).

• Que fait l'utilisateur dans tout ça ?

Donc l'utilisateur ne fait rien à part changer d'enregistrement dans une liste déroulante. Et le graphe excel de l'objet OLE est MAJ. Et les futurs utilisateurs, d'après ma chef, ne sont pas doués etc... lambda quoi, c'est pourquoi l'objet ne peut être modifié.

• Que doit-on obtenir à l'arrivée.

Il y a à côté du graphe un bouton excel, qui permettra l'export du classeur de l'objet OLE, export qui ouvrira excel avec les mêmes données dans une feuille, et le même graphe dans une autre. Comme l'utilisateur a l'habitude d'excel, c'est là qu'il modifiera ce qu'il voudra etc... et de plus ça enlève d'éventuels risques de modif à mon fichier access.

• Excel reste t-il ouvert ?

comme précédemment:
Donc quand il clique sur le bouton export à coté de l'objet OLE dans access, ça ouvre Excel application avec la feuille et le graphe exporté.

• Le classeur 2 existe t-il aussi ?

Donc quand excel est ouvert après export, l'utilisateur voit les données et le graphe, il peut y faire ce qu'il veut. Le fichier étant "sans titre" c'est après qu'il peut l'enregister, d'après mon premier cas de figure. Dans l'autre cas, c'est un fichier modèle, donc il existe.


1 - export vers classeur xls vierge
Là j'arrive à exporter les données dans la feuille, et je dois créer le graphe, comme le classeur est vierge au départ. Donc j'imagine qu'il faut que je réécrive du VBA dans Access dans la procédure d'export, afin de piloter excel qui créera le graphe à partir des données exportées.

2 - export vers classeur xls basé sur modèle xlt
Mais là je suis en train de changer un peu mon fusil d'épaule, j'ai créé un fichier modèle (.xlt) que j'ai mis dans un repertoire du serveur. Il contient une feuille de données (avec les mêmes étiquettes que ma requete), et une feuille graphe. La feuille de données contient en plus un bouton "MAJ graphe" qui en fait supprime puis recrée le graphe en fonction des données.
Comme ça l'utilisateur, lorsqu'il clique sur le bouton export sur le formulaire access, arrivera sur le fichier xls (basé sur le modèle) avec tout de fait, avec en plus le bouton de MAJ graphe lorsqu'il retouche à ses données.

Procédure d'ouverture du modele xlt sans transfert de données:

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
Sub OuvrirModeleAvecDonnees(Chemin As String) ', oFeuille As Worksheet, oGraph As Chart)
Dim xlApp As Excel.Application, oWb As Excel.Workbook
On Error Resume Next
Set xlApp = GetObject(, "Excel.application")
If err = "ERR_NOT_RUNNING" Then
    err.Clear
    Set xlApp = CreateObject("Excel.application")
End If
 
Set oWb = xlApp.Workbooks.Add("" & Chemin & "") 'chemin du fichier
 
oWb.RunAutoMacros xlAutoOpen
 
xlApp.Visible = True
Set oWb = Nothing
Set xlApp = Nothing
End Sub

Avec un call OuvrirModeleAvecDonnees("V:\fsdfs.xlt") sur l'évnement clic du bouton

Donc en fait il me reste juste à coder le transfért du résultat de la requête sur la feuille de données du ficher excel et simuler le clic bouton "MAJ données", tout cela en ouverture du fichier excel. (la macro MAJ données est déjà opérationnelle).

Dois-je coder cela juste avant le end sub du code ci-dessus (donc pilotage d'excel par access) ou le mettre dans le module VBA ThisWorkbook du classeur xlt? (Il me semble que this workbook) est une sorte de macro de démarrage dans excel)

J'espère être clair et pas trop long, mais c'est vrai que si j'explique succintement, ça peut être flou, et si je suis complet, je sais pas si le lecteur peut s'y retrouver, et ça peut être barbant à lire également !

[argyronet]

Mouais....

Bon, tu te compliques bien la vie...
Tu peux faire de l'OLE certes, c'est d'ailleurs la meilleure solution dans ton cas.
Il faut effectivement un XLT déjà formaté, ça gagnera du temps.
Tu peux aussi un poser des cellules nommées : cela sera plus pratique pour la suite avec la table de données correspondantes.

Ce que tu peux faire :
A/ Préparatifs

1. Dans ton XLT, tu construits un tableau (au niveau d'une cellule nommée pour la cellule Haut-Gauche) sur la feuille cible qui représente exactement la propriété RowSource de ton Graphique dans Access.
2. Tu y loges des données bidons.
3. Tu insères alors un graphique fondé sur ces données tel que le graphe doit être construit.
4. Ton garphique étant construit, tu le mets en forme comme il se doit et le plus fidèlement possible à celui visible dans le formulaire Access
5. Tu sauves et tu fermes le XLT

B/ Mise en oeuvre

1. Ta procédure de "déplacement/copie" du graphique se traduit par l'ouverture du XLT en tant que nouveau classeur.
2. Tu ne génères aucun graphique, il est déjà là.
3. Tu parcours ton RecordSet et tu loges les valeurs dans le tableau où se situe la cellule nommée de tout à l'heure comme point de départ.
4. Ton graphique va se mettre automatiquement à jour.

Voilà, c'est fini.

Argy

[kir4000]

Bon j'ai fini par finir !

Avant tout, merci a argyonet qui a su m'orienter, parce que a chaque fois j'explore plein de solution, et je m'embourbe tout le temps

Voici ma méthode:
Déjà, je ne copie pas l'objet OLE Excel de mon formulaire vers un nouveau classeur Excel. La macro de génération de (graphique automatique ou pas) n'est pas exactement la même en plus.
Par le clique sur le formulaire, pour résumer j'ouvre un modèle excel, avec une feuille de données alimentée par la même requete que la feuille de données de l'objet ole. et le graph se met à jour en faisant appel à la macro de mon modèle excel, depuis la procédure VBA Access de génération du rapport.

En PJ l'aspect de mon formulaire avec le graphe OLE Objet, la feuille de données du classeur, et la feuille graphe du classeur.

1- graph de l'objet OLE du formulaire
1.1 - Code sur le form_current de mon formulaire qui met a jour mon objet OLE graphique:

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
Private Sub Form_Current()
Call redimen4 'redimensionne le form a chaque changment
Dim Jour As Date
Jour = Date
Me.date_jour = DateEnLettre(Jour)
 
Dim oWb As Excel.Workbook, ofeuille As Worksheet, ograph As Chart, sql As String ', JusteNomSubEtiquette As SubForm
 
Set oWb = Forms.RA_Performance_Cargo.RA_Performance_Cargo_graphe.Object
Set ofeuille = oWb.Worksheets(1)
Set ograph = oWb.Charts(1)
 
sql = "SELECT Avion, [Charge maximale], [RA max payload], [RA 0 payload], [KinkPointCharge], [KinkPointRange] from RA_Performance_Cargo WHERE (InStr(1, SelectionAvions(), Avion) > 0)"
 
Call ExporteRequeteToObjetExcel(oWb, ofeuille, ograph, sql) ', Procedure)
Call RA_Performance_Cargo_Etiq(oWb, ofeuille, ograph)
 
Set ofeuille = Nothing
Set ograph = Nothing
Set oWb = Nothing
 
Call Afficher_cacher_valeurs_btn_Click 'cacher puis réafficher, en fait c'est juste pour que la police des echelles soient nickels, elles ne le sont pas du 1er coup sans cette petite manip
Call Afficher_cacher_valeurs_btn_Click
 
End Sub

1.2 - procédure ExporteRequeteToObjetExcel

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
Sub ExporteRequeteToObjetExcel(oWb As Excel.Workbook, ofeuille As Worksheet, ograph As Chart, sql As String) ', Procedure As s)
    Dim qdf As QueryDef
    Dim rst As Recordset
    Dim fld As Field
    Dim i As Integer
 
Set rst = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
 
    ' copie les en-têtes
    i = 1
    For Each fld In rst.Fields
        ofeuille.Cells(1, i).Value = fld.Name
        i = i + 1
    Next fld
 
    ' copie le contenu du recordset
    ofeuille.Cells(2, 1).CopyFromRecordset rst
    ofeuille.Cells(2, 9).FormulaR1C1 = "0"
 
    rst.Close
    Set rst = Nothing
    Set qdf = Nothing
End Sub

1.3 - procédure du collage d'étiquette sur mon graphe OLE

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
Public Sub RA_Performance_Cargo_Etiq(oWb As Excel.Workbook, ofeuille As Worksheet, ograph As Chart)
 
'ETAPE 1 : Suppression des séries du graphique
 
Dim NbLigne As Integer, SautLigne As Integer, NbSérie As Long, j As Variant, NumSerie As Variant, Xmax As Variant, Ymax As Variant
 
'NbLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'ne prend pas en compte si un gars met une valuer n'importe où plus bas dans la premiere colonne, nbligne comptera meme les lignes a cases vide, donc fausserait tout
For j = 1 To 1000     'parcourt les 1000 premieres lignes (c'est ce qu'on appelle une boucle)
    If ofeuille.Cells(j, 1) = "" Then  'ofeuille=activesheet, la sheet 1 'ograph=activecart
        NbLigne = j - 1 '(11 - cette ligne J vide)
        Exit For 'interruption de la boucle
    End If
Next j
j = 0
 
ograph.Activate
NbSérie = ograph.SeriesCollection.Count
For j = 1 To NbSérie
    With ograph
    .SeriesCollection(1).Delete   'si seriescollection(i), ça ne peut marcher car quand on i va delete le seriescollection(1) , eh bine le numéro 2 devient numéro 1 !
    End With
Next j
j = 0
 
'initialisation des min et max des axes
Xmax = 0 'ofeuille.Range("F2").Value 'en abscisse, range
Ymax = 0 'ofeuille.Range("B2").Value 'en ordonné, payload
 
'ETAPE 2 : Création des séries et recherche valeurs max pour les axes
'oFeuille.Cells(1, 7).Value = 0 'les 0 sont indispensables pour les séries
'oWb.Sheets(2).Cells(1, 7) = 0
 
NumSerie = 1
NbSérie = 0
For j = 2 To NbLigne
    If ofeuille.Range("B" & j).Value = "" And ofeuille.Range("C" & j).Value = "" And ofeuille.Range("D" & j).Value = "" And ofeuille.Range("E" & j).Value = "" And ofeuille.Range("F" & j).Value = "" Then
    Else
    ograph.SeriesCollection.NewSeries 'seriescollection (j-1) sinon on commence par n°série=2 et donc ça bug après
    ograph.SeriesCollection(NumSerie).Name = "=Feuil1!R" & j & "C1"
    ograph.SeriesCollection(NumSerie).XValues = _
        "=(Feuil1!R2C7,Feuil1!R" & j & "C3,Feuil1!R" & j & "C6,Feuil1!R" & j & "C4)"
    ograph.SeriesCollection(NumSerie).Values = _
        "=(Feuil1!R" & j & "C2,Feuil1!R" & j & "C2,Feuil1!R" & j & "C5,Feuil1!R2C7)"
    NumSerie = NumSerie + 1
    NbSérie = NbSérie + 1 'en fait s'il n'y a pas de série construite, cela poise probleme pour la determination des axes (la procédure après le next j). Donc si le nbsérie=0, on sautera l'étape de détermination des axes
    End If
    'échelles max des axes
    If ofeuille.Range("D" & j).Value > Xmax Then
        Xmax = ofeuille.Range("D" & j).Value
    End If
    If ofeuille.Range("B" & j).Value > Ymax Then
        Ymax = ofeuille.Range("B" & j).Value
    End If
Next j
 
If NbSérie = 0 Then
    Exit Sub
End If
 
Xmax = Xmax - (Xmax Mod 1000) + 1000
Ymax = Ymax - (Ymax Mod 10000) + 10000
'Affectation des echelles max
ograph.Axes(1).MinimumScale = 0 '- 5 'ou graph.axes(xlvalue) en access
ograph.Axes(1).MaximumScale = Xmax '+ (Xmax / 5) '+ 5
ograph.Axes(2).MinimumScale = 0 '- 5
ograph.Axes(2).MaximumScale = Ymax '+ (Ymax / 5) '+ 5 'pour 701 on a 771, pour 201, on a 221
 
'Ecart entre les reperes d'echelle
If Ymax > 100000 Then
    ograph.Axes(2).MajorUnit = 20000
ElseIf Ymax > 40000 Then
    ograph.Axes(2).MajorUnit = 10000
ElseIf Ymax > 20000 Then
    ograph.Axes(2).MajorUnit = 5000
Else
    ograph.Axes(2).MajorUnit = 2500
End If
If Xmax > 8000 Then
    ograph.Axes(1).MajorUnit = 2000
ElseIf Xmax > 4000 Then
    ograph.Axes(1).MajorUnit = 1000
Else
    ograph.Axes(1).MajorUnit = 500
End If
 
'Légende mise en forme
If ograph.HasLegend = False Then 'si pas de légende, la cré, puis transparente, puis redimension de la largeur du graph
    ograph.HasLegend = True
    ograph.Legend.Font.Size = 10
    'transparence de la legende
    ograph.Legend.Position = xlRight
    ograph.Legend.Shadow = False
    ograph.Legend.Interior.ColorIndex = xlNone
    With ograph.Legend.Border
    .Weight = xlHairline
    .LineStyle = xlNone
    End With
    ograph.PlotArea.Width = ograph.ChartArea.Width
End If
End Sub

2 - Export en excel
2.1 - clic sur le bouton du formulaire

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
Private Sub Commande57_Click() 'méthode export avec mise en forme, marche bien
Dim sql As String, Titre As String, Chemin As String  'chemin est inutile mais le mentionner car indispensable pour la fonction fExportExcel
Dim Rs As Recordset
Dim Excl As Object
 
Titre = "Cargo : Payload / Range"
sql = "SELECT trucs from RA_Performance_Cargo WHERE (InStr(1, SelectionAvions(), Avion) > 0)"
'InStr(1, SelectionAvions(), Avion>0 est en fait la liste des éléments sélectionné sur une zone liste multiple pour la comparaison avant de lancer le formulaire.
Chemin = "chemin...xlt"
 
Set Rs = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
 
If (Rs.BOF = True And Rs.EOF = True) Then 'en cas d'absence e données dans le tableau sous form, ou pb
Msgbox "Il n'y a pas de valeurs données dans le tableau !"
Exit Sub
End If
 
Set Excl = fExportExcel(Titre, Rs, Chemin, True, 3, 1) 'implantation sur excel à partir de la ligne 3
End Sub

2.2 - prrocédure de muadabi adaptée dans mon cas
Le fichier lancé n'est pas chemin.xlt mais chemin1.xls.

J'ai remarqué que sur mon code ça marceh, mais si on utilisait le code original de muadabi avec les déclarations de variables as objet, ça lançait réélement le modele.xlt, donc risque de scratchage...

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
Function fExportExcel(ByVal Titre As String, ByVal Arg_rs As DAO.Recordset, _
                    ByVal Arg_Path As String, _
                    Optional ByVal Arg_MEF As Boolean = False, _
                    Optional ByVal Arg_Ligne As Integer = 1, _
                    Optional ByVal Arg_Colonne As Integer = 1) As Object
'Déclarations
Dim i As Integer
Dim j As Integer
Dim NbrChamps As Integer
 
Dim ExcelApp As Excel.Application
Dim oWbmodele As Excel.Workbook
Dim ExcelSheet As Excel.Worksheet
'On Error GoTo fExportExcel_Err
 
 
If Arg_Path & "" = "" Then
'Set ExcelApp = GetObject(, "Excel.application")
'If err = "ERR_NOT_RUNNING" Then
'    err.Clear
    Set ExcelApp = CreateObject("Excel.application")
    Set oWbmodele = ExcelApp.Workbooks.Add
Else
'    Set ExcelApp = GetObject(Arg_Path, xls)
    Set ExcelApp = CreateObject("Excel.application")
'    Set ExcelApp = GetObject(Arg_Path, "Excel.application")
    Set oWbmodele = ExcelApp.Workbooks.Add("" & Arg_Path & "") 'chemin du fichier
    oWbmodele.RunAutoMacros xlAutoOpen
End If
Set ExcelSheet = oWbmodele.Worksheets(1)
 
'--------------------------------
'Set ExcelApp = GetObject(, "Excel.application")
'If err = "ERR_NOT_RUNNING" Then
'    err.Clear
'    Set ExcelApp = CreateObject("Excel.application")
'    Set oWbmodele = ExcelApp.Workbooks.Add
'Else
'    Set oWbmodele = ExcelApp.Workbooks.Add("" & Arg_Path & "") 'chemin du fichier
'    ExcelApp.RunAutoMacros xlAutoOpen
'End If
'Set ExcelSheet = oWbmodele.Worksheets(1)
 
'--------------------------existence d'un fichier modèle
'If Arg_Path & "" = "" Then         ' si pas de fichier model
'    Set ExcelApp = CreateObject("Excel.application").Workbooks.Add
'    Set ExcelSheet = ExcelApp.Worksheets(1)
'Else 'fichier modèle
'    Set ExcelApp = GetObject(Arg_Path, xls)
'    Set ExcelSheet = ExcelApp.Worksheets(1)
'End If
'--------------------------------------------------------------
ExcelApp.Application.Visible = True
ExcelApp.Windows(1).Visible = True
'ExcelApp.Application.Visible = True
 
 
'''''
'ofeuille.Range("A2:H248").ClearContents
 
 
'existence des données
If Not (Arg_rs.BOF = True And Arg_rs.EOF = True) Then 'il y a des données à exporter
    ExcelSheet.Range("A4:G200").ClearContents
 
 
    Arg_rs.MoveLast
    Arg_rs.MoveFirst
    NbrChamps = Arg_rs.Fields.Count
 
    'For i = Arg_Ligne To 100
        'ExcelSheet.Cells(i, 7).ClearContents
 
 
 
    'Titre de colonne
    For i = 0 To NbrChamps - 1
        ExcelSheet.Cells(Arg_Ligne, i + Arg_Colonne) = Arg_rs(i).Name
    Next
 
    'copie des infos
    ExcelSheet.Cells(1, 1) = Titre ' le titre
        'mise en forme titre
    With ExcelSheet.Cells(1, 1).Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Bold = True
        .Italic = True
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 41
    End With
            'Range("A1").Select
            'Selection.Font.ColorIndex = 41
            ''Selection.Font.Bold = True
            ''Selection.Font.Italic = True
            ''Selection.Font.Underline = xlUnderlineStyleSingle
            'With Selection.Font
            '    .Name = "Arial"
            '    .Size = 14
            '    .Strikethrough = False
            '    .Superscript = False
            '    .Subscript = False
            '    .OutlineFont = False
            '    .Shadow = False
            '    .Underline = xlUnderlineStyleSingle
            '    .ColorIndex = 41
            'End With
 
    ExcelSheet.Cells(Arg_Ligne + 1, Arg_Colonne).CopyFromRecordset Arg_rs
    'mise en forme si arg_cadre = true
    If Arg_MEF = True Then
        'datage
        With ExcelSheet.Cells(Arg_rs.RecordCount + Arg_Ligne + 1, NbrChamps - 1 + Arg_Colonne)
            .Value = "'" & Format(Now, "dd/mm/yyyy")
            .Font.Size = 6
            .HorizontalAlignment = xlRight
        End With
 
        'cadre + couleur des titres
 
        'with = la zone tableau
        With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne, Arg_Colonne), _
                ExcelSheet.Cells(Arg_Ligne + Arg_rs.RecordCount, _
                Arg_Colonne + NbrChamps - 1))
            .Borders(xlInsideVertical).Weight = xlThin
            .Borders(xlInsideHorizontal).Weight = xlThin
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlEdgeBottom).Weight = xlMedium
            .Borders(xlEdgeRight).Weight = xlMedium
        End With
 
        With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne, Arg_Colonne), _
            ExcelSheet.Cells(Arg_Ligne, Arg_Colonne + NbrChamps - 1))
            .Interior.ColorIndex = 37
            .Borders(xlEdgeBottom).Weight = xlMedium
        End With
 
'        oWbmodele.RunAutoMacros CréerGraphe
        ExcelApp.Run "CréerGraphe"
 
        ExcelSheet.Cells.WrapText = False
        'With Selection
        'VerticalAlignment = xlBottom
        'WrapText = False
        'Orientation = 0
        'ShrinkToFit = False
        'MergeCells = False
        'Msgbox "er"
        'End With
 
        'Application.CurrentProject.Path & "\test.xls" enregistré dans le repertoire de l'appli access frontal
 
    Else
    End If
Else
    Msgbox "pas de données"
End If
 
'DoCmd.RunCommand acCmdOutputToExcel  'reste a arriver sur le fichier excel, et ne pas avoir a coté le fichier exporter à la con
    'ExcelApp.Windows(1).Visible = True
    'Excel.Application.Visible = True
 
GoTo fExportExcel_Exit
 
fExportExcel_Err:
'    Msgbox "Une erreur inattendue est apparue dans la fonction fExportExcel. L'erreur N° " & _
'        err.Number & " ( " & err.Description & " )! Contactez l'administrateur.", _
'        vbOKOnly + vbCritical, "Erreur inattendue !"
    Set fExportExcel = Nothing
    Exit Function
fExportExcel_Exit:
    Set fExportExcel = ExcelApp
    Set ExcelApp = Nothing
End Function

Au départ j'avais appeler la macro excel CréerGraphe dans le workbook_open, mais évidemment dans mon cas, ça créait le graphe, alors que les données n'avait pas encore été envoyées. Donc on lance la macro à la fin (ExcelApp.Run "CréerGraphe")

2.3 - Enfin, La macro CréerGraphe dans un MODULE (surtout pas dans le code d'une feuille) dans le fichier modèle.xlt :
A la différence de la macro graphe de l'objet OLE, je n'ai pas à redéfinir les échelles en VBA. Mais il y a mieux à faire justement sur ce paramétrage de l'échelle de l'objet OLE (le code du 1.3)

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
Public Sub Créergraphe()
Dim NumSerie As Variant, NbLigne As Integer, J As Variant 'derniere ligne
NumSerie = 1
On Error GoTo Err_créergraphe
'--------------------------------
'Etape 1 création du type de graphique et son nom doit être numéroté 1 ou CHart(1)
'suppression de l'ancien
Sheets(1).Select
Application.DisplayAlerts = False
Charts(1).Delete
Application.DisplayAlerts = True
'création du graphe
Charts.Add
ActiveChart.ChartType = xlXYScatterLines  'définit le type de graphique, ici un nuage de points relié par des traits
ActiveChart.SetSourceData Source:=Sheets("Données").Range("B17")
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Graphe"
 
'----------------------------------------------------------------
'ETAPE 2 : Récupération du nombres de lignes à traiter
'déclaration des variables
 
'NbLigne : compte le nombre de lignes du tableau
For J = 4 To 50     'parcourt les 50 premieres lignes (c'est ce qu'on appelle une boucle)
    If Sheets("Données").Cells(J, 1) = "" Then 'Or Sheets("Données").Cells(J, 3) = "" Then 'à la premiere case vide de la colonne A (numéro1), on récupère la dernière ligne où une valeur y figure une valeur, et on interrompt la boucle
        NbLigne = J - 1
        Exit For 'interruption de la boucle
    End If
Next J
J = 0
 
'----------------------------------------------------------------
'ETAPE 3 : (Re)Création des séries
 
For J = 4 To NbLigne 'ex : la série(1 ou j-1) recoit les valeurs dela ligne 2 (ou j), la série2 recoit les valeurs de la ligne3 etc
'nextJ:
    If Sheets("Données").Cells(J, 3) = "" And Sheets("Données").Cells(J, 4) = "" Then
'    If " & Données!R" & J & "C3 & " = "" Then ' And Données.Range("C" & J).Value = "" Then
    Else
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection.NewSeries 'seriescollection (j-1) sinon on commence par n°série=2 et donc ça bug après
    ActiveChart.SeriesCollection(NumSerie).Name = "=Données!R" & J & "C1"
    ActiveChart.SeriesCollection(NumSerie).XValues = _
        "=(Données!R2C9,Données!R" & J & "C4,Données!R" & J & "C7,Données!R" & J & "C5)" 'ces lignes de défintion des sources est propre à ce graphique,à adapter selon les graphiques spécifiques à des tableaux particuliers
    ActiveChart.SeriesCollection(NumSerie).Values = _
        "=(Données!R" & J & "C3,Données!R" & J & "C3,Données!R" & J & "C6,Données!R2C9)"
'    If Sheets("Données").Cells(J, 3) = "" Then
'        If J < NbLigne Then
'            J = J + 1
'            GoTo nextJ
'        Else
'            Exit For
'        End If
'    Else
    NumSerie = NumSerie + 1
    End If
'MsgBox "" & NumSérie & ""
Next J
J = 0
 
'-----------------------------------------------------------------
'ETAPE 4 : MISE EN FORME DU GRAPHE
ActiveChart.HasLegend = True 'activation de la légende
ActiveChart.Legend.Select  'transparence, mise en forme... de la legende
Selection.Position = xlRight
Selection.Shadow = False
Selection.Interior.ColorIndex = xlNone
With Selection.Border
    .Weight = xlHairline
    .LineStyle = xlNone
End With
 
ActiveChart.PlotArea.Select
With Selection.Border
    .ColorIndex = 16
    .Weight = xlThin
    .LineStyle = xlContinuous
End With
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, _
    Degree:=1
With Selection
    .Fill.Visible = True
    .Fill.ForeColor.SchemeColor = 36
End With
 
With ActiveChart.Axes(xlCategory)
    .HasMajorGridlines = True
    .HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
    .HasMajorGridlines = True
    .HasMinorGridlines = False
End With
 
ActiveChart.Axes(xlValue).MajorGridlines.Select
With Selection.Border
    .ColorIndex = 15
    .Weight = xlHairline
    .LineStyle = xlDot
End With
 
ActiveChart.Axes(xlCategory).MajorGridlines.Select
With Selection.Border
    .ColorIndex = 15
    .Weight = xlHairline
    .LineStyle = xlDot
End With
 
ActiveChart.PlotArea.Width = ActiveChart.ChartArea.Width
Sheets("Données").Activate 'retour a la feuille
ActiveSheet.Cells(1, 1).Select
 
Err_créergraphe:
Exit Sub
End Sub
 
 
'''''NE SERT PLUS MAINTENANT, ET PAS MIS A JOUR COMME AVEC NumSerie PAR EXEMPLE, DONC PAS UTILISABLE POUR LE MOMENT
Public Sub Séries()
 
'ETAPE 1 : Suppression des séries du graphique
 
Dim NbLigne As Integer, SautLigne As Integer, NbSérie As Long, J As Variant, var As Variant 'derniere ligne
 
'NbLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'ne prend pas en compte si un gars met une valuer n'importe où plus bas dans la premiere colonne, nbligne comptera meme les lignes a cases vide, donc fausserait tout
For J = 1 To 1000       ' Limite à adapter à tes besoins
    If ActiveSheet.Cells(J, 1) = "" Then
        NbLigne = J - 1
        Exit For
    End If
Next J
J = 0
MsgBox "" & NbLigne & ""
 
Charts("Graphe").Activate
NbSérie = ActiveChart.SeriesCollection.Count
 
For J = 1 To NbSérie
        With ActiveChart
        .SeriesCollection(1).Delete   'si seriescollection(i), ça ne peut marcher car quand on i va delete le seriescollection(1) , eh bine le numéro 2 devient numéro 1 !
        End With
Next J
J = 0
 
'ETAPE 2 : (Re)Création des séries
For J = 2 To NbLigne
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection.NewSeries 'seriescollection (j-1) sinon on commence par n°série=2 et donc ça bug après
    ActiveChart.SeriesCollection(J - 1).XValues = _
        "=(Données!R2C10,Données!R" & J & "C5,Données!R" & J & "C7,Données!R" & J & "C8)"
    ActiveChart.SeriesCollection(J - 1).Values = _
        "=(Données!R" & J & "C4,Données!R" & J & "C4,Données!R" & J & "C6,Données!R2C10)"
    ActiveChart.SeriesCollection(J - 1).Name = "=Données!R" & J & "C1"
Next J
 
If ActiveChart.HasLegend = False Then 'si pas de légende, la cré, puis transparente, puis redimension de la largeur du graph
    ActiveChart.HasLegend = True
    ActiveChart.Legend.Select  'transparence de la legende
    Selection.Position = xlRight
    Selection.Shadow = False
    Selection.Interior.ColorIndex = xlNone
    With Selection.Border
    .Weight = xlHairline
    .LineStyle = xlNone
    End With
    ActiveChart.PlotArea.Select
    ActiveChart.PlotArea.Width = ActiveChart.ChartArea.Width
End If
 
Sheets("Données").Activate 'retour a la feuille
ActiveSheet.Cells(1, 1).Select
 
End Sub

Voila !

et 4 - n'oubliez pas de certifier avec selfcert.exe votre fichier modèle.xlt, et de le faire lancer une fois par vos utilisateurs pour qu'il coche la case "faire confiance à ce certificat", afin qu'il n'aient pas à chaque fois à activer les macro lors de l'export excel.

Il y a plus simple, mais ça marche nickel. Ce qui a compliqué la chose est en fait la complexité du graphique (plusieurs series de courbes construit par nuages de point XY...) fiou !

Bonne fin de journée