Discussion :

[Williamm]

Bonjour,

Voilà mon petit soucis:

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

avec ce code:

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 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 :

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
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 :

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
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 :

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
 
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 :

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
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 :

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

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 :

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

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 :

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

xlApp.Run "QUERYu.xlsm!Do_It"

par

Code :

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

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 :

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

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 :

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

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+