Discussion :

[fortuna]

Bonjour,

je souhaite exporter le résultat de plusieurs filtres ( liste déroulante ) sur un formulaire En Excel , en cliquant sur un bouton tout simplement.

pour info : j'obtiens le résultat des filtres en cliquant sur un bouton de commande dont le code est :

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Private Sub CmdFiltre_Click()
f = ""
If Not IsNull(Me.RRLP) And Me.RRLP <> "" Then
f = "RLP LIKE ""*" & Me.RRLP & "*"""
End If
If Not IsNull(Me.RCalibres) And Me.RCalibres <> "" Then
If f <> "" Then
f = f & " AND Calibre = """ & Me.RCalibres & """"
Else
f = "Calibre = """ & Me.RCalibres & """"
End If
End If
If Not IsNull(Me.RRCP) And Me.RRCP <> "" Then
If f <> "" Then
f = f & " AND RCP = """ & Me.RRCP & """"
Else
f = "RCP = """ & Me.RRCP & """"
End If
End If
If Not IsNull(Me.RLPR) And Me.RLPR <> "" Then
If f <> "" Then
f = f & " AND LPR = """ & Me.RLPR & """"
Else
f = "LPR = """ & Me.RLPR & """"
End If
End If
If Not IsNull(Me.RLD) And Me.RLD <> "" Then
If f <> "" Then
f = f & " AND Batiment = """ & Me.RLD & """"
Else
f = "Batiment = """ & Me.RLD & """"
End If
End If
If Not IsNull(Me.RRQP) And Me.RRQP <> "" Then
If f <> "" Then
f = f & " AND RQP LIKE ""*" & Me.RRQP & "*"""
Else
f = "RQP LIKE ""*" & Me.RRQP & "*"""
End If
End If
If Not IsNull(Me.RE_FTA) And Me.RE_FTA <> "" Then
If f <> "" Then
f = f & " AND Etat_FTA LIKE ""*" & Me.RE_FTA & "*"""
Else
f = "Etat_FTA LIKE ""*" & Me.RE_FTA & "*"""
End If
End If
If Not IsNull(Me.RDPA) And Me.RDPA <> "" Then
If f <> "" Then
f = f & " AND DPA LIKE ""*" & Me.RDPA & "*"""
Else
f = "DPA LIKE ""*" & Me.RDPA & "*"""
End If
End If
If Not IsNull(Me.RPRI) And Me.RPRI <> "" Then
If f <> "" Then
f = f & " AND PRI LIKE ""*" & Me.RPRI & "*"""
Else
f = "PRI LIKE ""*" & Me.RPRI & "*"""
End If
End If
If Not IsNull(Me.RNiveau) And Me.RNiveau <> "" Then
If f <> "" Then
f = f & " AND Niveau LIKE ""*" & Me.RNiveau & "*"""
Else
f = "Niveau LIKE ""*" & Me.RNiveau & "*"""
End If
End If
If Not IsNull(Me.Rdate1) And Me.Rdate1 <> "" And Not IsNull(Me.Rdate2) And Me.Rdate2 <> "" Then
If f <> "" Then
f = f & " AND clng([Date de détection]) BETWEEN " & CLng(Me.Rdate1) & " AND " & CLng(Me.Rdate2) & ""
Else
f = "clng([Date de détection]) BETWEEN " & CLng(Me.Rdate1) & " AND " & CLng(Me.Rdate2) & ""
End If
End If
Me.Filter = f
Me.FilterOn = True
End Sub

Merci de m 'aider je suis bloqué pour l'instant ,je suis débutant en VBA , ce code je l ai trouve sur le net.

Cdlt

Quand tu postes du code, tu dois l'insérer dans les balises !
http://dolphy35.developpez.com/images/Balises.gif

[Pittouti]

Bonjour Fortuna,

tu dois créer une table intermédiaire dans laquelle tu stocke le résultat ( via une requête ajout ) et tu exporte cette table sous format excel.

Pense à purger ta table ( Requête suppression ) après chaque export.

[fortuna]

Merci pour ton aide ,
ce que je pensais faire , par une requête ou une table mais comment , par code ou macro?
Si par code ,je ne sais pas comment faire par VBA.

Cdlt

[Pittouti]

tu peux utiliser l'un ou l'autre.

tout dépends de ce que tu maitrise.

en VBA tu utilisera Docmd.runsql pour tes requêtes

et DoCmd.OutputTo pour l'export

[fortuna]

Justement je sais pas comment faire ,
un vba à intégrer dans le code que j ai cite ou créer un bouton à part ?

[Invité]

Bonsoir,

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
Me.FilterOn = True
Set rs = Me.Recordset.OpenRecordset
Set xls = CreateObject("Excel.application")
xls.Visible = True
 
 
Set wb = xls.workbooks.Add
Set sh = wb.sheets.Add
 
 
For I = 0 To rs.Fields.Count - 1
    sh.range("A1").offset(0, I) = rs(I).Name
Next
sh.range("A2").CopyFromRecordset rs
wb.saveas "C:\toto.xlsx"
wb.Close False
xls.Quit

[fortuna]

Merci ça marche bien ,
Je souhaite afficher une boite de dialogue pour proposer l enregistrement dans un répertoire au choix.
merci

[fortuna]

Merci ça marche bien ,
Je souhaite afficher une boite de dialogue pour proposer l enregistrement dans un répertoire au choix.
merci

Bonsoir,

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
Me.FilterOn = True
Set rs = Me.Recordset.OpenRecordset
Set xls = CreateObject("Excel.application")
xls.Visible = True
 
 
Set wb = xls.workbooks.Add
Set sh = wb.sheets.Add
 
 
For I = 0 To rs.Fields.Count - 1
    sh.range("A1").offset(0, I) = rs(I).Name
Next
sh.range("A2").CopyFromRecordset rs
wb.saveas "C:\toto.xlsx"
wb.Close False
xls.Quit

[tee_grandbois]

Bonjour,
regarde ici : http://www.developpez.net/forums/d16...l-nom-colonne/
la solution est dans le module utilisant BrowseForFolder

[fortuna]

Comment l'inserer dans mon code ?
Merci

Bonjour,
regarde ici : http://www.developpez.net/forums/d16...l-nom-colonne/
la solution est dans le module utilisant BrowseForFolder

[tee_grandbois]

Bonjour,
j'ai intégré le choix du dossier dans le code donné par dysorhographie :

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
' Déclaration des variables pour l'affichage du choix de dossier
Dim objShell As Object
Dim objFolder As Object
Dim strMessage As String
Dim strChemin As String
 
Me.FilterOn = True
Set rs = Me.Recordset.OpenRecordset
Set xls = CreateObject("Excel.application")
xls.Visible = True
 
' Chargement des variables pour l'affichage des répertoires 
strMessage = "Sélection d'un répertoire de sauvegarde :" 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, strMessage, 1)
 
Set wb = xls.workbooks.Add
Set sh = wb.sheets.Add
 
For I = 0 To rs.Fields.Count - 1
    sh.range("A1").offset(0, I) = rs(I).Name
Next
sh.range("A2").CopyFromRecordset rs
 
' Affichage des répertoires et sélection du chemin dossier
On Error Resume Next  ' Evite le message d'erreur 91 si on sort sans sélection
strChemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
 
' Dossier par défaut si pas de sélection
If strChemin = "" then strChemin = "C:"
 
' Sauvegarde du fichier Excel
wb.saveas strChemin & "\" & "toto.xlsx"
wb.Close False
xls.Quit

[fortuna]

Merci pour ton aide , ça marche mais j ai une feuille vide d'excel en premier plan devant la boite de dialogue , comment virer cette page excel en premier plan?
y a t il un moyen que le nom du fichier soit saisi par l'utilisateur sur la boite de dialogue?

[Invité]

Code :

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

1
2
3
wb.Application.DisplayAlerts = False
wb.Sheets(1).Delete
wb.Application.DisplayAlerts = True

[fortuna]

Ça ne fonctionne pas

Code :

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

1
2
3
wb.Application.DisplayAlerts = False
wb.Sheets(1).Delete
wb.Application.DisplayAlerts = True

[tee_grandbois]

Bonsoir,
je propose une solution à ton problème mais j'espère que cela sera ta dernière demande concernant le post d'origine (exporter un résultat vers Excel). La prochaine fois, évite de poser une nouvelle question une fois que quelqu'un t'as trouvé une solution pour le précédent.
Je te remercie, après avoir testé ce code, de marquer ce post comme résolu. Ouvres un autre post si tu as une autre demande ne concernant pas directement comment exporter vers Excel.

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
 
' Déclaration des variables pour l'affichage du choix de dossier
Dim objShell As Object
Dim objFolder As Object
Dim strMessage As String
Dim strChemin As String
 
Me.FilterOn = True
Set rs = Me.Recordset.OpenRecordset
Set xls = CreateObject("Excel.application")
 
' Chargement des variables pour l'affichage des répertoires
strMessage = "Sélection d'un répertoire de sauvegarde :"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, strMessage, 1)
 
Set wb = xls.Workbooks.Add
Set sh = wb.Sheets.Add
 
For I = 0 To rs.Fields.Count - 1
    sh.Range("A1").Offset(0, I) = rs(I).Name
Next
sh.Range("A2").CopyFromRecordset rs
 
' Affichage des répertoires et sélection du chemin dossier
On Error Resume Next  ' Evite le message d'erreur 91 si on sort sans sélection
strChemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
 
' Dossier par défaut si pas de sélection
If strChemin = "" Then strChemin = "C:"
 
' Affichage de la fenêtre pour sauvegarde du fichier Excel
 
 xls.Dialogs(xlDialogSaveAs).Show strChemin & "\" & "toto.xlsx"
wb.Close False
xls.Quit

[fortuna]

Merci pour votre aide , j ai pu avancer 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
Set rs = Me.Recordset.OpenRecordset
Set xls = CreateObject("Excel.application")
xls.Visible = True
 
 
Set wb = xls.Workbooks.Add
Set sh = wb.Sheets.Add
 
 
For I = 0 To rs.Fields.Count - 1
    sh.Range("A1").Offset(0, I) = rs(I).Name
Next
sh.Range("A2").CopyFromRecordset rs
xls.Visible = True

Du coup j ai une feuille Excel avec les résultats du filtre qui s'affiche à l écran , que je peux l'enregistrer .

Merci .