[AC-2003] Lancer une macro excel à partir d'access

[Williamm]

Bonjour,

Voilà mon petit soucis:

A partir d'Access, je crée un fichier Excel

avec ce code:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Commande2_Click()
 
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
 
NomFichier = "c:\QUERYu.xls"
xlBook.SaveAs NomFichier 
xlBook.Close
xlApp.Quit
 
Set xlBook = Nothing 
Set xlApp = Nothing
 
End Sub

J'aimerai bien lorsque ce fichier Excel se crée, exécuter une macro Excel qui ressemble à: (je l'ai faite avec l'enregistreur de macro pour avoir le code)

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
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 02/08/2011 par Air France
'
 
'
    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=D:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 02_08.m" _
        ), Array( _
        "db;DefaultDir=D:\Documents and Settings\2594215\Bureau\William AF\test william;DriverId=25;FIL=MS Access;MaxBufferSize=2048;Pag" _
        ), Array("eTimeout=5;")), Destination:=Range("B6"))
        .CommandText = Array( _
        "SELECT `R_Tableau 1S`.Expr1, `R_Tableau 1S`.Horaire1, `R_Tableau 1S`.`02/01/2012`, `R_Tableau 1S`.`03/01/2012`, `R_Tableau 1S`.`04/01/2012`, `R_Tableau 1S`.`05/01/2012`, `R_Tableau 1S`.`06/01/2012`, `" _
        , _
        "R_Tableau 1S`.`07/01/2012`, `R_Tableau 1S`.`08/01/2012`, `R_Tableau 1S`.`09/01/2012`, `R_Tableau 1S`.`10/01/2012`, `R_Tableau 1S`.`11/01/2012`, `R_Tableau 1S`.`12/01/2012`, `R_Tableau 1S`.`13/01/2012`" _
        , _
        ", `R_Tableau 1S`.`14/01/2012`, `R_Tableau 1S`.`15/01/2012`, `R_Tableau 1S`.`16/01/2012`, `R_Tableau 1S`.`17/01/2012`, `R_Tableau 1S`.`18/01/2012`, `R_Tableau 1S`.`19/01/2012`, `R_Tableau 1S`.`20/01/20" _
        , _
        "12`, `R_Tableau 1S`.`21/01/2012`, `R_Tableau 1S`.`22/01/2012`, `R_Tableau 1S`.`23/01/2012`, `R_Tableau 1S`.`24/01/2012`, `R_Tableau 1S`.`25/01/2012`, `R_Tableau 1S`.`26/01/2012`, `R_Tableau 1S`.`27/01" _
        ,,,,,,,,,,,,,,,,,,,,,,,)
        .Name = "Lancer la requête à partir de MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

ESt possible de gerer tout ça grace au VBA Access et comment ?

[LedZeppII]

Bonjour,

Voici un exemple

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
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlQryTbl As Excel.QueryTable
Dim NomFichier As String
Dim sODBCconn As String, sSQL As String
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
 
' Chaîne de connexion ODBC
sODBCconn = "ODBC;DSN=MS Access Database;" & _
            "DBQ=E:\Mes Documents\Access\Comptoir.mdb"
' Code SQL de la requête
sSQL = "SELECT DISTINCTROW Commandes.Destinataire, Commandes.[Adresse livraison], " & _
            "Commandes.[Ville livraison], Commandes.[Région livraison], Commandes.[Code postal livraison], " & _
            "Commandes.[Pays livraison], Commandes.[Code client], Clients.Société, Clients.Adresse, " & _
            "Clients.Ville, Clients.Région, Clients.[Code postal], Clients.Pays, " & _
            "[Prénom] & ' ' & [Nom] AS Vendeur, Commandes.[N° commande], Commandes.[Date commande], " & _
            "Commandes.[À livrer avant], Commandes.[Date envoi], Messagers.[Nom du messager], " & _
            "[Détails commandes].[Réf produit], Produits.[Nom du produit], " & _
            "[Détails commandes].[Prix unitaire], [Détails commandes].Quantité, " & _
            "[Détails commandes].[Remise (%)], " & _
            "CCur([Détails commandes].[Prix unitaire]*[Quantité]*(1-[Remise (%)])/100)*100 AS PrixTotal, " & _
            "Commandes.Port" & vbCrLf & _
       "FROM Produits INNER JOIN (Messagers INNER JOIN " & _
            "(Employés INNER JOIN ((Clients INNER JOIN Commandes ON " & _
            "Clients.[Code client] = Commandes.[Code client]) INNER JOIN " & _
            "[Détails commandes] ON Commandes.[N° commande] = [Détails commandes].[N° commande]) " & _
            "ON Employés.[N° employé] = Commandes.[N° employé]) " & _
            "ON Messagers.[N° messager] = Commandes.[N° messager]) " & _
            "ON Produits.[Réf produit] = [Détails commandes].[Réf produit];"
' Création requête Excel
Set xlQryTbl = xlBook.ActiveSheet.QueryTables.Add(sODBCconn, xlBook.ActiveSheet.Range("B6"))
' Paramétrage requête Excel
With xlQryTbl
    .CommandText = sSQL
    .Name = "Requête Comptoir.mdb"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False
 
 
NomFichier = "C:\QUERYu.xls"
xlBook.SaveAs NomFichier
 
Set xlQryTbl = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

Ligne 13 : il te faut mettre le chemin complet vers ta base de données
Ligne 15 : il te faut mettre le code SQL de ta requête
Ligne 38 : change le nom de la requête Excel

A+

[dave92]

Bonjour,

Je te propose une solution alternative.

1 - Tout d'abord tu crées un fichier "Modèle.xls" qui contient ta macro nommée "Public Sub DO_IT" dans un module.

2 - Dans mon exemple, le modèle est placé dans le répertoire "P:\", le fichier nouveau fichier est également créé dans le répertoire "P:\".

Dans Access le code devient donc :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub Commande2_Click()
Dim xlApp As New Excel.Application
Dim xlBook As Workbook
Dim NomFichier As String
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Open ("P:\Modele.xls")
Set xlBook = xlApp.ActiveWorkbook
NomFichier = "P:\QUERYu.xls"
xlBook.SaveAs NomFichier
xlApp.Run "QUERYu.xlsm!Do_It"
xlBook.Close SaveChanges:=True
xlApp.Quit
 
Set xlBook = Nothing
Set xlApp = Nothing
 
End Sub

Pour info, j'ai fiat un test concluant avec Access & Excel 2007, mais il n'y a pas de raison pour que cela ne fonctionne pas en Office 2002.

[Williamm]

Merci pour vos réponses,

LedzeppII, voilà comment j'ai adapté ton code:

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
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlQryTbl As Excel.QueryTable
Dim NomFichier As String
Dim sODBCconn As String, sSQL As String
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
 
' Chaîne de connexion ODBC
sODBCconn = "ODBC;DSN=MS Access Database;" & _
            "DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 02_08.mdb"
' Code SQL de la requête
sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]=""MAN"",1,IIf([R_QueryTableaupresent 1S].[Expr1]=""TECH"",2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]=""M"",1,IIf([R_QueryTableaupresent 1S].[Horaire1]=""S"",2,3));"
 
 
 
 
' Création requête Excel
Set xlQryTbl = xlBook.ActiveSheet.QueryTables.Add(sODBCconn, xlBook.ActiveSheet.Range("B6"))
' Paramétrage requête Excel
With xlQryTbl
    .CommandText = sSQL
    .Name = "R_Tableau 1S.mdb"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False
 
 
NomFichier = "C:\QUERYuu.xls"
xlBook.SaveAs NomFichier
 
Set xlQryTbl = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

Le Excel se crée mais ne se rempli pas. Le problème est qu'il m'affiche une erreur sur la ligne:

Code :

xlQryTbl.Refresh False

Dans Access ça m'affiche: Erreur execution 1004, erreur général ODBC
Tu sais pourquoi ?

Dave92, ton code marcehe bien puisqu'il me crée un fichier excel avec ma requete. Par contre dans Access il m'affiche en erreur sur la ligne:

Code :

xlApp.Run "QUERYu.xlsm!Do_It"

Peut être l'extension .xlsm ne marche pas avec excel 2003?


Je pense que vous pouvez p-t aussi m'aider sur une chose (je profite de votre compétence, je vous remercie d'ailleurs)
Dans l'idéal (je ne sais pas si c'est possible) j'ai crée un formulaire avec un champ "Num Année". Une fois que l'utilisateur rentre le numero de l'année avec le format 00, j'aimerai en cliquant sur le bouton, creer le fichier excel avec comme nom: Query + le numéro de l'année que l'utilisateur a entré dans le formulaire. Tout ça en conservant ensuite la procédure de la macro que vous m'avez expliqué plus haut. Est possible en VBA?


Merci pour votre aide

[dave92]

J'ai effectivement fait mon test avec office 2007. l'extenstion xlsm n'est pas compatible avec office 2003.

Dans mon code remplace les extentions xlsm par xls et ca devrait passer.

[Williamm]

Ca marche mais ça génère toujours des erreurs sur la même ligne :/

LedzeppII si jamais tu as la solution au message d'erreur qui s'affiche lorsque j'exécute ton code ça me sauverai je pense. (je suis en Access 2003)

Merci

[dave92]

tu as bien remplacé

Code :

xlApp.Run "QUERYu.xlsm!Do_It"

par

Code :

xlApp.Run "QUERYu.xls!Do_It"

?

le nom de la macro dans le fichier modèle est bien "DO_IT" ?

[LedZeppII]

Bonjour,

Apparemment ça vient de la requête, à cause des " dans les IIF.
Essaie en remplaçant

Code :

sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]=""MAN"",1,IIf([R_QueryTableaupresent 1S].[Expr1]=""TECH"",2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]=""M"",1,IIf([R_QueryTableaupresent 1S].[Horaire1]=""S"",2,3));"

par

Code :

sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"

Chez moi ça solutionne l'erreur ODBC.

A+

[Williamm]

Merci c'est parfait
J'ai même réussi à intégré mon problème de variable dans le titre de mon fichier excel

Merci
Will

[Williamm]

Petite question:

Est il possible de créer le Excel non pas avec une exportation de requête mais avec deux?

La première se trouvant à la cellule B6 et l'autre à la cellule B24 par exemple?
Comment dois je m'y prendre?

Dans mon cas je voudrai donc rajouter la requête suivante

Code :

1
2
3
SELECT *
FROM [R_QueryTableaupresent 2S]
ORDER BY IIf([R_QueryTableaupresent 2S].[Expr1]="MAN",1,IIf([R_QueryTableaupresent 2S].[Expr1]="TECH",2,3)), IIf([R_QueryTableaupresent 2S].[Horaire1]="M",1,IIf([R_QueryTableaupresent 2S].[Horaire1]="S",2,3));

et quelle se trouve à la cellule B24

[LedZeppII]

Envoyé par Williamm

Petite question:
Est il possible de créer le Excel non pas avec une exportation de requête mais avec deux?

Oui, c'est possible.
Il suffit de répéter la séquence

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
' Code SQL de la requête
sSQL = "SELECT * FROM ... ;"
 
' Création requête Excel
Set xlQryTbl = xlBook.ActiveSheet.QueryTables.Add(sODBCconn, xlBook.ActiveSheet.Range("B6"))
' Paramétrage requête Excel
With xlQryTbl
    .CommandText = sSQL
    .Name = "R_Tableau 1S.mdb"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False

en changeant ....

• xlBook.ActiveSheet.Range("B6") par xlBook.ActiveSheet.Range("B24") dans la ligne où on crée la requête (ici 5)
• le nom de la requête excel (ligne 9)

Par contre je ne sais pas ce qui se passe si la première requête atteint ou dépasse la ligne 24.

A+

[Williamm]

Je te remercie c'est parfait,

J'ai une autre petite question:

J'ai un fichier Excel existant qui contient 2 feuilles.
La première feuille contient une requête Access importée nommé "Tableau1" qui représente un tableau de valeur d'un semestre et la deuxième feuille contient une requête Access importée nommé "Tableau2" qui représente un tableau de valeur du semestre suivant..

J'aimerai en fait que lorsqu'on passe d'un semestre S(i-1) à un semestre S(i)
on puisse figer les valeur du tableau S(i-1) et créer ensuite une 3eme feuille contenant le semestre S(i+1)

La requête "Tableau1" contiendra tjrs les valeurs du 1er semestre de l'année et la requête "Tableau2" les valeurs du 2eme semestre de l'année.

Exemple:
Mon fichier contient à la base un onglet "S1 2012" et un onglet "S2 2012"
Quand on passe de "S1 2012" au "S2 2012" (dans la réalité) j'aimerai figer les valeurs "S1 2012" et créer un 3ème onglet nommé "S1 2013" contenant la requête qui servait au préalable à l'onglet "S1 2012"

Pour cela j'ai crée un formulaire avec un champ "Année" qui devra rentrer dans une variable pour pouvoir donner le nom de la feuille créée en fonction de l'année saisie. Je pense aussi qu'il faudra deux boutons: un qui permettra de créer l'onglet 1er Semestre avec la requete "Tableau1" et l'autre l'onglet 2eme semestre avec la requête "Tableau2".

Par contre, ej ne m'y connais pas assez en VBA pour programmer la fixation des valeurs de S(i-1) et la création d'onglet à chaque clique de bouton contenant la requête appropriée et le nom de la feuille en fonction de l'année saisie dans le formulaire.

J'espere avoir été assez clair. Si c'est pas le cas n'hésitez pas à me le dire.
Merci de votre aide,
Will

[Williamm]

J'ai essayé de cette manière mais j'ai un problème.
Quand je veux ajouter une feuille dont je sais qu'elle n'existe pas, il me dit qu'elle existe quand même alors qu'il devrait sortir de la boucle pour me la créer :s

Code:

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
Private Sub Commande5_Click()
 
    Dim xlQryTbl As Excel.QueryTable
    Dim sODBCconn As String, sSQL As String
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim Annee As Variant
    Dim NomFichier As Variant
    Annee = Me![Num Année]
    NomFichier = "2onglets.xls"
 
    ' Démarrer Excel et le rendre visible
 
    Set xl = CreateObject("Excel.Application")
    xl.Workbooks.Open ("C:\" & NomFichier)
    xl.Visible = True
    On Error Resume Next
    xl.UserControl = True
    xl.Close
 
    ' Créer un classeur pour le test
    Set wbk = xl.Worksheet.Add()
 
    ' Test de l'existence d'une feuille
    If FeuilleExiste(wbk, "S1 " & Annee & " ") Then
       MsgBox "La feuille S1 " & Annee & "   existe deja.", vbInformation
 
    'Fermer le classeur sans l'enregistrer
    wbk.Close False
    Set wbk = Nothing
 
    ' Quitter Excel
    xl.Quit
    Set xl = Nothing
 
    Else
       ActiveSheet.Name = "S1 " & Annee & " "
 
 
' Chaîne de connexion ODBC
sODBCconn = "ODBC;DSN=MS Access Database;" & _
            "DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 03_08.mdb"
' Code SQL de la requête
sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"
 
 
 
 
' Création requête Excel
Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("B6"))
 'Paramétrage requête Excel
With xlQryTbl
    .CommandText = sSQL
    .Name = "R_Tableau 1S.mdb"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
End With
' Exécute requête
xlQryTbl.Refresh False
 
NomFichier = "C:\" & NomFichier
wbk.SaveAs NomFichier
 
Set xlQryTbl = Nothing
wbk.Close
Set wbk = Nothing
xl.Quit
Set xl = Nothing
 
    End If
 
End Sub

Vous savez pourquoi ?

[LedZeppII]

Bonjour,

J'ai fait quelques modifications dans ton code.

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
    Dim xlQryTbl As Excel.QueryTable
    Dim sODBCconn As String, sSQL As String
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim xlSheet as Excel.WorkSheet
    Dim Annee As Variant
    Dim NomFichier As Variant
    Annee = Me![Num Année]
    NomFichier = "2onglets.xls"
 
    ' Démarrer Excel et le rendre visible
 
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workbooks.Open("C:\" & NomFichier)
    xl.Visible = True
    'On Error Resume Next
    xl.UserControl = True
 
    ' Test de l'existence d'une feuille
    If FeuilleExiste(wbk, "S1 " & Annee & " ") Then
       MsgBox "La feuille S1 " & Annee & "   existe deja.", vbInformation
 
       'Fermer le classeur sans l'enregistrer
       wbk.Close False
       Set wbk = Nothing
 
       ' Quitter Excel
       xl.Quit
       Set xl = Nothing
 
    Else
       ' Créer une nouvelle feuille après la dernière feuille
       Set xlSheet = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
       xlSheet.Name = "S1 " & Annee & " "
       xlSheet.Activate
 
       ' Chaîne de connexion ODBC
       sODBCconn = "ODBC;DSN=MS Access Database;" & _
                   "DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 03_08.mdb"
       ' Code SQL de la requête
       sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"
 
       ' Création requête Excel
       Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("B6"))
       'Paramétrage requête Excel
       With xlQryTbl
           .CommandText = sSQL
           .Name = "R_Tableau 1S.mdb"
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .BackgroundQuery = True
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = True
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .PreserveColumnInfo = True
       End With
       ' Exécute requête
       xlQryTbl.Refresh False
 
       wbk.Save
 
       Set xlQryTbl = Nothing
       Set xlSheet = Nothing
       wbk.Close
       Set wbk = Nothing
       xl.Quit
       Set xl = Nothing
 
    End If

J'ai ajouté une variable objet xlSheet de type Excel.WorkSheet, et déplacé la partie création d'une nouvelle feuille après le Else.

A+

[Williamm]

Merci ça marche niquel, tu me permets d'avancer dans mon projet c'est super.

Il y a une chose délicate a laquelle je n'ai pas pensé.

Ma requête que j'exécute (celle qui apparaît dans le Word) doit également changer en fonction de l'année que l'utilisateur saisie.
Pour cela je dois au préalable exécuter 7 requêtes ajout pour mettre à jour ma requête que je veux obtenir sur le excel.

J'ai pour cela enregistrer une macro sur Access. Comment dois je l'incorporer dans le VBA de mon bouton click ?

Ou alors, faut t-il exécuter mes requêtes Ajout en les écrivants directement ds le VBA?

[LedZeppII]

Envoyé par Williamm

Ma requête que j'exécute (celle qui apparaît dans le Word) doit également changer en fonction de l'année que l'utilisateur saisie.
Pour cela je dois au préalable exécuter 7 requêtes ajout pour mettre à jour ma requête que je veux obtenir sur le excel.

J'ai pour cela enregistré une macro sur Access. Comment dois je l'incorporer dans le VBA de mon bouton click ?

Tu peux utiliser

Code :

DoCmd.RunMacro "Nom de la macro"

pour une macro Access (par opposition à macro VBA).

[Williamm]

Merci !

Un petit bug intervient une fois que la feuille excel se crée avec le tableau de ma requete: tout marche bien sur le excel mais le Access plante :s

Je pense que c'est un problème dû a la sauvegarde du Excel avec la nouvelle feuille. car parfois il me demande si je veux sauvegarder le excel et apres ça plante.

Il y a un moyen de régler la sauvegarde pour ne pas avoir de bug une fois que la feuille est crée?

Je te montre le code pour que tu vois ou j'en suis:

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
Private Sub Commande5_Click()
 
    Dim xlQryTbl As Excel.QueryTable
    Dim sODBCconn As String, sSQL As String
    Dim xl As Excel.Application
    Dim wbk As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim Annee As Variant
    Dim NomFichier As Variant
    Annee = Me![Num Année]
    NomFichier = "2onglets.xls"
 
    ' Demarre la requete ajout
 
    DoCmd.RunMacro "M3 Horrairemystere.Rempliossage horraire disvié"
 
 
    ' Démarrer Excel et le rendre visible
 
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workbooks.Open("C:\" & NomFichier)
    xl.Visible = True
    On Error Resume Next
    xl.UserControl = True
 
    ' Test de l'existence d'une feuille
    If FeuilleExiste(wbk, "S1 " & "." & Annee & " ") Then
       MsgBox "La feuille S1 " & "." & Annee & "    existe deja.", vbInformation
 
       'Fermer le classeur sans l'enregistrer
       wbk.Close False
       Set wbk = Nothing
 
       ' Quitter Excel
       xl.Quit
       Set xl = Nothing
 
    Else
       ' Créer une nouvelle feuille après la dernière feuille
       Set xlSheet = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
       xlSheet.Name = "S1 " & "." & Annee & " "
       xlSheet.Activate
 
       ' Chaîne de connexion ODBC
       sODBCconn = "ODBC;DSN=MS Access Database;" & _
                   "DBQ=d:\Documents and Settings\2594215\Bureau\William AF\test william\TESTen coursMennecyAmeliore 04_08.mdb"
       ' Code SQL de la requête
       sSQL = "SELECT * FROM [R_QueryTableaupresent 1S] ORDER BY IIf([R_QueryTableaupresent 1S].[Expr1]='MAN',1,IIf([R_QueryTableaupresent 1S].[Expr1]='TECH',2,3)), IIf([R_QueryTableaupresent 1S].[Horaire1]='M',1,IIf([R_QueryTableaupresent 1S].[Horaire1]='S',2,3));"
 
       ' Création requête Excel
       Set xlQryTbl = wbk.ActiveSheet.QueryTables.Add(sODBCconn, wbk.ActiveSheet.Range("B6"))
       'Paramétrage requête Excel
       With xlQryTbl
           .CommandText = sSQL
           .Name = "R_Tableau 1S.mdb"
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .BackgroundQuery = True
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = True
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .PreserveColumnInfo = True
       End With
       ' Exécute requête
       xlQryTbl.Refresh False
 
       wbk.Save
 
       Set xlQryTbl = Nothing
       Set xlSheet = Nothing
       wbk.Close
       Set wbk = Nothing
       xl.Quit
       Set xl = Nothing
 
    End If
 
End Sub

Tu vois ou se situe le problème?

[LedZeppII]

Il faudrait mettre en commentaire la ligne

Code :

    On Error Resume Next

pour savoir sur quelle ligne ça plante.

[Williamm]

Alors meme si je le met en commentaire ca ne m'affiche pas d'erreur.
Access plante sans laisser de message :s

[Williamm]

En faisant une croix au moment d'enregistrer il ma mis une erreur sur:

Code :

wbk.Save