Discussion :

[chartreuse]

Bonsoir,

J'aimerai exporter des données filtrées d'un formulaire vers Excel via un bouton.
J'ai créé un formulaire qui filtre des données via une requête et qui s'affiche sur mon formulaire.

J'ai créé une macro "exporter avec mise en forme" via un bouton.

Mon problème est que le fichier Excel enregistre toute la base et non mes champs renseignés.
Merci...

[hyperion13]

Salut
Votre questionnement n'est pas clair du tout.
Par "champs renseignés" entendez-vous les objets indépendants filtres date/destinataire/expéditeur?
Si c'est le cas, ces objets sont-ils bien présents dans la zone critères de votre qry?

[chartreuse]

Dans mon formulaire quand j'applique un filtre par exemple une date les données s'affichent correctement. Mais quand j'exporte les données via mon bouton sur excel c'est la base entière qui est exportée.

[hyperion13]

Votre form a-t-il bien comme source de données la qry r_filtre?
Comment avez-vous construit cette qry r_filtre?

[chartreuse]

Oui mon form à comme source la requête.
J'ai construit ma requête à partir de ma base réception et j'ai mis les champs qui me convenais

Pa requête fonctionne car les données affichées sont corrects. C'est au moment de l'extraction vers EXCEL que çà me donne ma base complète.
Peut-être que je devrait faire l'extraction Excel à partir d'un état et non d'un formulaire ?

[hyperion13]

A la lecture de votre capture d'écran Post#5, je ne vois pas de critères pour date de réception !
Parce que à minima vous devriez avoir Entre [Formulaires]![frm]![txtdatedeb] Et [Formulaires]![frm]![txtdatefin].
Alors comment exécutez-vous l'action de filtrer le form?

[chartreuse]

J'exécute le formulaire par un filtre au clique d'un bouton

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
Private Sub Commande75_Click()
f = ""
If Not IsNull(Me.Texte13) And Me.Texte13 <> "" Then
f = "Destinataire LIKE ""*" & Me.Texte13 & "*"""
End If
If Not IsNull(Me.Texte68) And Me.Texte68 <> "" Then
If f <> "" Then
f = f & " AND Expéditeur LIKE ""*" & Me.Texte68 & "*"""
Else
f = "Expéditeur LIKE ""*" & Me.Texte68 & "*"""
End If
End If
If Not IsNull(Me.date_debut) And Me.date_debut <> "" And Not IsNull(Me.date_fin) And Me.date_fin <> "" Then
If f <> "" Then
f = f & " AND [Date de réception] BETWEEN #" & Format(Me.date_debut, "mm-dd-yyyy") & "# AND #" & Format(Me.date_fin, "mm-dd-yyyy") & "#"
Else
f = "[Date de réception] BETWEEN #" & Format(Me.date_debut, "mm-dd-yyyy") & "# AND #" & Format(Me.date_fin, "mm-dd-yyyy") & "#"
End If
End If
Me.Filter = f
Me.FilterOn = True
End Sub

[tee_grandbois]

bonjour,
puisque tu utilises le VBA pour appliquer ton filtre, pourquoi ne pas l'utiliser aussi pour l'export Excel ?
Tu as la possibilité d'exporter le Recordset du formulaire avec la commande CopyfromRecordset dont 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
Dim ors As Recordset
Dim oApp As Object
Dim oWkb As Object
Dim oWSht As Object
Dim i As Long
 
' création instance excel
Set oApp = CreateObject("Excel.application")
' Création du nouveau classeur
Set oWkb = oApp.Workbooks.Add
 
Set oWSht = oWkb.Worksheets(1) ' ici le nom de la feuille ou juste son index
 
' récupération des données issues du formulaire
Set ors = Me.Recordset.OpenRecordset
 
If Not ors.EOF Then
    ' copie des entêtes de colonnes
    For i = 0 To ors.Fields.Count - 1
        oWSht.Range("A1").Offset(0, i) = ors(i).Name
    Next
    ' copie des données
    oWSht.Range("A2").CopyFromRecordset ors
    ' sauvegarde du classeur
    oWkb.SaveAs "D:\NomDuFichier.xlsx"
    oWkb.Close True
End If
 
oApp.Quit
Set ors = Nothing
Set oApp = Nothing

éventuellement, fais une recherche sur le forum avec le mot-clé copyfromrecordset si tu veux d'autres exemples

[chartreuse]

tee_grandbois
merci pour le code. Cà marche pour l'extraction.
Comment fait-on pour laisser le choix à l'utilisateur de l'emplacement du fichier Excel ?

[tee_grandbois]

oui, il faut remplacer cette ligne:

Code :

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

    oWkb.SaveAs "D:\NomDuFichier.xlsx"

par celles-ci:

Code :

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

1
2
3
' Sauvegarde du fichier Excel avec ouverture boite de dialogue "Enregistrer sous"
   oApp.Visible = True
   oApp.Dialogs(xlDialogSaveAs).Show "NomDuFichier.xlsx"

[chartreuse]

Merci tee_grandbois et hyperion13

[chartreuse]

Désolé mais je réouvre la discussion car le code ne fonctionne pas.
Quand je clique sur mon bouton Excel s'ouvre bien avec les bonnes données filtrées mais quand je sauvegarde j'ai ce message d'erreur

sur la ligne en gras

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 Commande76_Click()
Dim ors As Recordset
Dim oApp As Object
Dim oWkb As Object
Dim oWSht As Object
Dim i As Long
 
' création instance excel
Set oApp = CreateObject("Excel.application")
' Création du nouveau classeur
Set oWkb = oApp.Workbooks.Add
 
Set oWSht = oWkb.Worksheets(1) ' ici le nom de la feuille ou juste son index
 
' récupération des données issues du formulaire
Set ors = Me.Recordset.OpenRecordset
 
If Not ors.EOF Then
    ' copie des entêtes de colonnes
    For i = 0 To ors.Fields.Count - 1
        oWSht.Range("A1").Offset(0, i) = ors(i).Name
    Next
    ' copie des données
    oWSht.Range("A2").CopyFromRecordset ors
    ' Sauvegarde du fichier Excel avec ouverture boite de dialogue "Enregistrer sous"
    oApp.Visible = True
    oApp.Dialogs(xlDialogSaveAs).Show "NomDuFichier.xlsx"
    oWkb.Close True
End If
 
oApp.Quit
Set ors = Nothing
Set oApp = Nothing
End Sub

[User]

Bonsoir,

Avez-vous cocher la référence pour microsoft Excel ?

Sinon, peut-être essayer avec la valeur 5 au lieu de xlDialogSaveAs.

Cdlt,

[tee_grandbois]

bonsoir User,
la référence Excel n'est pas utile puisque le code utilisé est en liaison tardive, mais utiliser la valeur numérique de la constante xlDialogSaveAs est effectivement une solution.

[User]

Salut Tee

bonsoir User,
la référence Excel n'est pas utile puisque le code utilisé est en liaison tardive, mais utiliser la valeur numérique de la constante xlDialogSaveAs est effectivement une solution.

C'est juste, et on peut aussi préciser que s'il avait mis Option Explicit en haut de son module, il aurait tout de suite vu à la compilation que xlDialogSaveAs n'était pas déclarée dans son environnement, avec un message du genre variable non définie (contrairement à dbOpenDynaset par exemple).

Cdlt,

[hyperion13]

Salut tout le monde
Je viens de faire une adaptation rapide avec NorthWind et la sub() du Post#12 et fonctionne très bien.

[tee_grandbois]

bonjour hyperion13,
merci pour la confirmation. J'ai également testé le code avant de le poster (comme à mon habitude, je le signale sur le post quand je ne le peux pas).

J'avais pensé à la possibilité que ce soit le nom du fichier (ou plutôt son extension xlsx) qui pose problème mais je ne vois pas comment et pourquoi étant donné la version office très récente de chartreuse)

[User]

Resalut,

bonjour hyperion13,
merci pour la confirmation. J'ai également testé le code avant de le poster (comme à mon habitude, je le signale sur le post quand je ne le peux pas).

J'avais pensé à la possibilité que ce soit le nom du fichier (ou plutôt son extension xlsx) qui pose problème mais je ne vois pas comment et pourquoi étant donné la version office très récente de chartreuse)

Tu as quoi comme version et quelles références de cochées ?, parce que moi j'avais le même souci que chartreuse sans la référence Excel

Cela dit ton code fonctionne ce n'est pas la question

[tee_grandbois]

j'ai Access 2013 sur mon PC, j'ai plusieurs références cochées (Access, Office, Word, Outlook etc..) mais pas Excel mais il faut remplacer xlDialogSaveAs par 5 comme tu l'as indiqué pour que cela fonctionne.

[tee_grandbois]

je viens de faire le test avec une nouvelle base avec les références Access 2013 par défaut cochées:



cela fonctionne toujours ...