[DEPLACE] export requête Access vers Excel

Question

Bonjour,

Je sais que le sujet est récurrent mais malgré toutes les ressources que j'ai pu trouver sur le Net, je n'y suis toujours pas arrivé.
J'ai un fichier access dans lequel j'ai un formulaire comportant une liste déroulante. La valeur de cette liste déroulante sert de critère à une requête. En fait, on sélectionne un groupe dans la liste déroulante et la requête filtre les noms qui correspondent à ce groupe. Voici la requête :
    sSql = "SELECT STAGIAIRE.Nom" & _
    "FROM STAGIAIRE" & _
    "WHERE (((STAGIAIRE.Groupe)=[Formulaires]![Feuille_présence]![Modifiable8]));"

En cliquant sur un bouton, je souhaiterais que cette liste de noms soit exportée sur un fichier modèle Excel dont voici le chemin d'accès :
C:	est.xlt

Avec la méthode "TransferSpreadsheet", pas de problème mais je souhaiterais que la liste de noms soit recopiée à partir d'une cellule précise (Range("A5"))
J'ai essayé différent code que j'ai pu trouver sur le Net, j'ai bien coché dans la liste des référence sur l'éditeur VB :
Microsoft Excel 11.0 Object library (je tourne sous office 2003)
Microsoft DAO 3.6 Object library

Si quelqu'un a un lien qui correspondrait à peu près à ce que je cherche, je le remercie d'avance.

Bonne journée.

Si vous n'êtes pas né le 29 février, alors estimez qu'il y a plus malchanceux que vous !

sebmafate · Answer

Le rapport avec C# ?


Sébastien FERRAND
Lead Developpeur
Microsoft Visual C# MVP 2005 - 2009

c148270 · Answer

Bonjour
Voic une solution

    Dim appexcele As New excel.Application
    Dim WkbClasseur As excel.Workbook
    Dim WksFeuille As excel.Worksheet
    Set appexcele = Nothing
    Set WkbClasseur = Nothing
    Set WksFeuille = Nothing
    DoCmd.SetWarnings False
    Set appexcele = CreateObject("excel.application")
'    appexcele.Visible = True
    appexcele.Visible = False
    appexcele.DisplayAlerts = False
    Set WkbClasseur = appexcele.Workbooks.Open(Strprofile & "\applicat\prod\sc\lsd\Estimation\Modeleengagements.xLT")
    With WkbClasseur
        .Activate
'---------------------------------------------------------------------------------------
' Chargement des données
         Set WksFeuille = WkbClasseur.Worksheets("perma")
        With WksFeuille
            .Activate
            Set detail = CurrentDb.OpenRecordset("table")
            .Cells(2, 1).CopyFromRecordset detail
         End With


bonne journée

houtas · Answer

tu n'a pas bien cherché, il faut utiliser automation ceci permet de copier le contenu et les entêtes
Function TransfertExcelAutomation()

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
    
    t0 = Timer
    Dim rec As Recordset
    
    Set rec = CurrentDb.OpenRecordset("Clients", dbOpenSnapshot)
    
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
   
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = "Tutoriel"
   
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Export d'une table Access"
   
    
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
    
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
            Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
   
    ' code de fermeture et libération des objets
    xlBook.SaveAs "D:\Temp\Feuille.xls"
    xlApp.Quit
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    t1 = Timer
    Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"

End Function

meldja976 · Answer

Bonjour,

Merci pour vos réponses. J'avais déjà vu ces codes sur le Net. Ca marche nickel avec les enregistrements d'une table, mais pas d'une requête.
J'ai besoin de filtrer les enregistrements d'une table via une requête soit écrite en SQL dans le code, soit en l'appelant en tant qu'objet (je l'ai sauvegardée dans les objets access).
En fait, l'idée est d'alimenter une feuille de présence Excel. Les noms des stagiaires doivent alimenter la feuille de présence Excel en fonction d'un groupe sélectionné dans un combobox placé dans un formulaire.
La totalité de la table STAGIAIRE où sont contenus les noms ne m'intéresse pas.

En tout cas, encore merci pour vos réponses.

Sébastien Ferrand, je n'ai pas compris votre question.
Bonne fin de journée.

c148270 · Answer

Bonjour
Monexemple fonctionne avec les requêtes 
dans mon exemple
Set detail = CurrentDb.OpenRecordset("table") 
il suffit de remplacer "table" par le nom de la requête
ou dans l'exemple de houtas "client" par le nom de la requête

le .cells(2,1) indique que l'on copie le résultat en ligne 2 colonne 1

dans mon exemple copyfromrecordset copie l'intégralité des champs
l'exemple de houtas permet de chosir les champs à copier

Bonne journée

meldja976 · Answer

Bonjour,

J'ai testé mais j'ai une erreur de compilation avec le code proposé par houtas sur cette ligne :
    Set rec = CurrentDb.OpenRecordset("ReqStg", dbOpenSnapshot)
"ReqStg" étant le nom de la requête.

J'ai essayé de déclarer la variable requête :
Dim sSQL as string
sSQL = "SELECT STAGIAIRE.Nom FROM STAGIAIRE WHERE ((STAGIAIRE.Groupe)=Formulaires!Feuille_présence!Modifiable8));"
    Set rec = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)

Mais j'ai toujours une erreur de compilation sur la même ligne ("set rec = ...)

A priori, ça doit être ma requête qui ne fonctionne pas dans le code.

J'ai aussi essayé de déclarer le critère contenu dans le combobox :
Dim crit as string
crit = Me.Modifiable8.value

sSQL = "SELECT STAGIAIRE.Nom FROM STAGIAIRE WHERE ((STAGIAIRE.Groupe)=crit));"
    Set rec = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)

Toujours l'erreur de compilation sur la même ligne.

Je ne vois pas où est l'erreur.
Je peux déposer mon fichier sur ci-joint si quelqu'un veut y jeter un œil.

Encore merci pour votre aide.
Au fait, j'avais pas fait gaffe que j'étais sur le topik C#, désolé, je ne sais pas comment rediriger ce fil vers le bon topik.
Bonne journée

meldja976 · Answer

PS : la requête objet fonctionne bien sur test, peut être que la syntaxe en VB n'est pas bonne ?

meldja976 · Answer

Re,
c148270, j'ai aussi essayé ton code :

Private Sub Commande12_Click()
Dim appexcele As New Excel.Application
Dim WkbClasseur As Excel.Workbook
Dim WksFeuille As Excel.Worksheet
Set appexcele = Nothing
Set WkbClasseur = Nothing
Set WksFeuille = Nothing
DoCmd.SetWarnings False
Set appexcele = CreateObject("excel.application")
' appexcele.Visible = True
appexcele.Visible = False
appexcele.DisplayAlerts = False
Set WkbClasseur = appexcele.Workbooks.Open(Strprofile & "	est.xlt")
WkbClasseur.Activate

' Chargement des données
Set WksFeuille = WkbClasseur.Worksheets("Feuil1")
With WksFeuille
.Activate
Set detail = CurrentDb.OpenRecordset("ReqStg")
.Cells(2, 1).CopyFromRecordset detail
End With
DoCmd.SetWarnings True

End Sub

J'ai également une erreur sur :
Set detail = CurrentDb.OpenRecordset("ReqStg")

Ca coince toujours au niveau d'OpenRecordset.

Bonne journée

houtas · Answer

Pour la ligne qui provoque l'erreur de compil remplacer dbopensnapshot par dbopendynaset et ca va marcher

c148270 · Answer

Bonjour

Les codes fonctionnent avec la librairie DAO
L'écriture avec ADO est différente

En communiquant le message d'erreur nous aurions peut-être une piste

Bonne journée

meldja976 · Answer

Re,
Pour clôturer ce fil, je suis enfin parvenu à faire ce que je voulais : exporter des données contenues dans des contrôles de mon formulaires et celles d'une requête.
Voici mon code adapté à ma situation (si ça peut intéresser quelqu'un qui aurait le même besoin).
Public Function insert_excel()
On Error GoTo Fin
Dim db As Database
Dim rst As Recordset
Dim compteEnr As Long, chMsg As String
Dim varRetournée As Variant, lngX As Long
Dim temp As Variant

Dim sSQL As String
Dim crit As String
crit = Me.Modifiable8.Value
Dim rec As Recordset

Dim Etpse As String
Dim intitulé As String
Dim grp As String
Dim formateur As String
Dim H_D As Variant
Dim H_F As Variant
Dim jour As Date
Etpse = Me.Modifiable14
intitulé = Me.Modifiable34
formateur = Me.Modifiable37
grp = Me.Modifiable8
H_D = Me.Modifiable16
H_F = Me.Modifiable17
jour = Me.Calendar9

Set db = CurrentDb()
Set appExcel = CreateObject("Excel.Application")

'-> Si true excel s'affiche à l'écran
appExcel.Visible = True

'->ouverture du fichier excel, dans notre cas fichier Emargement.xlt
Set wbexcel = appExcel.Workbooks.Open("C:\Emargement.xlt")

'->selection de la feuille, dans notre cas feuille Presence
appExcel.Sheets("Presence").Select
    appExcel.Cells(2, 1) = Etpse
    appExcel.Cells(4, 1) = intitulé
    appExcel.Cells(6, 1) = grp
    appExcel.Cells(9, 3) = H_D
    appExcel.Cells(9, 6) = H_F
    appExcel.Cells(13, 3) = formateur
    appExcel.Cells(7, 2) = jour

sSQL = "SELECT STAGIAIRE.Nom FROM STAGIAIRE WHERE STAGIAIRE.Groupe=" & Chr(34) & crit & Chr(34)
'-> ouverture de la table
Set rec = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
With rec
' -> On quitte si la table T_travail est vide
If rec.RecordCount = 0 Then
'Beep
MsgBox "Données incompléte pour mise à jour des données !" & vbCr & vbCr & _
"Il n'y a pas de stagiaires !", vbExclamation, "Alerte utlisateur"
rec.Close
db.Close
Exit Function
Else
.MoveLast
.MoveFirst
compteEnr = .RecordCount
chMsg = "Mise à jour des données sources" & Date
varRetournée = SysCmd(acSysCmdInitMeter, chMsg, compteEnr)
ligne = 18
Do Until rec.EOF
For lngX = 1 To compteEnr
varRetournée = SysCmd(acSysCmdUpdateMeter, lngX)
'-> modification des données dans excel
appExcel.Cells(ligne, 2) = rec![Nom]
appExcel.Cells(ligne, 1) = lngX
'-> on passe à l'enregistrement suivant
rec.MoveNext
'-> on precise de passer à la ligne siuvante dans excel
ligne = ligne + 1
Next lngX
Loop
varRetournée = SysCmd(acSysCmdClearStatus)
End If
End With
rec.Close
db.Close

'-> sauvegarde des modifications de la feuille de calcul
'wbexcel.Save
 
'-> fermeture de la feuille de calcul
'wbexcel.Close
 
'-> Quitter Excel
'appexcel.Quit
'Set appexcel = Nothing
Exit Function
Fin:
MsgBox "Vérifiez que toutes les listes déroulantes soient" & vbCr & vbCr & _
"bien renseignées, à l'exeption des champs :" & vbCr & vbCr & _
"Heures début" & vbCr & _
"Heures fin", , "DONNEES INSUFFISANTE !"
End Function

Problème résolu, merci et bonne soirée

[DEPLACE] export requête Access vers Excel

11 réponses

Votre réponse

Discussions similaires