Discussion :

[Gaston62]

Bonjour,

Je veux ouvrir un classeur Excel dans lequel il y a une macro qui ouvre un UserForm et ce à partir d'Access avec ce

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
 
Private Sub Commande2_Click()
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim cheminFichier As String
 
    cheminFichier = "E:\Sauvegarde\Gaston\Access\2010\Vidéo\Graphiques\GraphFilmsActeur.xlsm"
 
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Open(cheminFichier)
 
    xlApp.Run "AfficherUserForm"
 
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub

Macro dans Excel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Sub AfficherUserForm()
    UserForm1.Show
End Sub

Jusque là, tout fonctionnes parfaitement.
Maintenant j'aimerais insérer le bout de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
xlApp.Run "Chemin!AfficherUserForm"

dans mon code existant (d'Access).
Il s'git d'un code pour ouvrir et exporter des données afin de créer un 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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub OuvrirGraphique(GraphName As String, GraphQuery As String, GraphTitle As String)
 
Dim Chemin As String 'chemin complêt
Dim xlAp As Object 'application Excel
Dim xlWB As Object 'workbook
Dim wbName As String 'nom du classeur
 
    wbName = GraphName & ".xlsm" 'Nom du classeur
 
    On Error Resume Next
    ' Essaye d'accéder à une instance d'Excel en cours
    Set xlAp = GetObject(, "Excel.Application")
 
    If err.Number <> 0 Then
        GoTo Suite
    End If
 
    On Error GoTo 0
 
    ' Vérifiez si le classeur est ouvert
    For Each xlWB In xlAp.Workbooks
        If xlWB.Name = wbName Then
            xlWB.Close SaveChanges:=False ' Ferme le classeur sans sauvegarder
            Exit For
        End If
    Next xlWB
 
Suite:
    Chemin = CurrentProject.Path & "\Graphiques\" & wbName 'graphpath
 
    Set xlAp = CreateObject("Excel.Application")
    Set xlWB = xlAp.Workbooks.Open(Chemin)
 
    xlApp.Run "Chemin!AfficherUserForm" ' appel de la macro dans le classeur
 
    Call Export2XL(xlWB, GraphQuery, Chemin, "Tableau", "Graphique", GraphTitle)
 
    xlWB.Close SaveChanges:=True
    Set xlWB = Nothing
 
    xlAp.Quit
    Set xlAp = Nothing
 
    Call OuvrirFichierXLS(Chemin) 'ouvre le fichier sans rendre le focus au formulaire
 
End Sub

Contenu de Export2XL :

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
 
Function Export2XL(wb As Object, requete As String, Fichier As String, feuille As String, chart As String, TITRE As String)
 
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim ws As Object
    Dim ch As Object
    Dim l As Long
    Const xlup = -4162
 
    Set db = CurrentDb
    Set rs = db.OpenRecordset(requete)
    Set ws = wb.Sheets(feuille)
 
    ws.Cells.Clear
    ws.Cells(1, 1).CopyFromRecordset rs
 
    rs.Close
    Set rs = Nothing
 
    db.Close
    Set db = Nothing
 
    Set ch = wb.Charts(chart) 'graphique en tant que feuille de type graphique
    ch.Activate
 
    l = ws.Cells(ws.Columns(1).Cells.Count, 1).End(xlup).Row
    ws.Range("B1:B" & l).NumberFormat = "##" 'nombre standard sans décimales
 
    On Error Resume Next 'Ignore les erreurs qui pourraient se déclencher sur la ligne suivante
    ch.SetSourceData ws.Range("A1:B" & l), PlotBy:=xlcolumns
    On Error GoTo 0 'Réactive les messages d'erreur
 
    ch.ChartTitle.text = TITRE
 
    Set ch = Nothing
 
End Function

Là le UserForm ne s'ouvre pas, mais aucun message d'erreur est généré.
La commande xlApp.Run "Chemin!AfficherUserForm" est-il bien placé dan la procédure "OuvrirGraphique" ?
Si oui, où est l'erreur et si non, où faut-il la placer ?
Pour info, le code pour exporter le graphique fonctionne parfaitement en dehors de ce problème d'affichage de UserForm.

Merci d'avance de vos réponses.

[User]

Bonjour,

Regardez ce lien :
https://www.developpez.net/forums/d2...-via-vbscript/

[Gaston62]

Bonjour et merci pour ta réaction User, mais je ne vois pas en quoi le lien que tu m'envoie puisse m'apporter une solution.
Mon problème n'est pas de lancer une macro Excel à partir d'Access, mais de savoir où je dois l’insérer dans mon code existant.
Le code pour ouvrir une macro, ainsi que le code d'exportation fonctionnent très bien séparément !

[User]

Quand vous exécutez la macro il faut lui donner le nom du classeur une fois ouvert comme indiqué dans le lien et pas chemin!nommacro..

[Gaston62]

Dans le "Sub Commande2_Click()" :

xlApp.Run "AfficherUserForm" fonctionne.
xlApp.Run "'GraphFilmsActeur.xlsm'!AfficherUserForm" fonctionne.
xlApp.Run "Chemin!AfficherUserForm" en effet, ne fonctionne pas. Je ne l'avais pas testé dans ce Sub.

Mais dans le "OuvrirGraphique(GraphName As String, GraphQuery As String, GraphTitle As String)" :

xlApp.Run "AfficherUserForm" ne fonctionne pas.
xlApp.Run "'GraphFilmsActeur.xlsm'!AfficherUserForm" ne fonctionne pas.
xlApp.Run "Chemin!AfficherUserForm" bien sûr, ne fonctionne pas.

Il y a donc autre chose qui cloche...

[User]

....

Mais dans le "OuvrirGraphique(GraphName As String, GraphQuery As String, GraphTitle As String)" :

xlApp.Run "AfficherUserForm" ne fonctionne pas.
xlApp.Run "'GraphFilmsActeur.xlsm'!AfficherUserForm" ne fonctionne pas.
xlApp.Run "Chemin!AfficherUserForm" bien sûr, ne fonctionne pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Set xlAp = CreateObject("Excel.Application")
Set xlWB = xlAp.Workbooks.Open(Chemin)
 
xlAp.Run "'GraphFilmsActeur.xlsm'!AfficherUserForm"

xlAp et non xlApp..
après je connais pas le nom exact de votre classeur

[Gaston62]

Exacte, petite erreur de ma part.
Il fallait mettre xlAp et non xlApp.
J'avais écrit xlApp dans mon test et j'ai bêtement copié la ligne dans mon code final.
Maintenant ça marche parfaitement.

Merci pour ton aide et bonne soirée !

[User]

Pas de soucis