Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1212 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [ACCESS] Rqt multicritere export vers Excel

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[ACCESS] Rqt multicritere export vers Excel

n°1672922
raymonizuk​a
Posté le 17-01-2008 à 17:53:57  profilanswer
 

Bonjour,  
 
Tout d'abord merci pour le site  
 
J'ai un créé un formulaire de recherche multicritère sous access qui filtre mon formulaire.  
Je voudrais pouvoir exporter ces données vers excel. Mais je n'exporte que le formulaire entier  
Je souhaiterai pouvoir choisir quels champs exporter lors de mon filtre.  
Mon niveau en vba ne me permet pas encore de trouver une solution.  
Toute aide est la bienvenue!  
 
PS j'ai lu le tuto de cafeine sur excel ---> http://cafeine.developpez.com/access/tutoriel/excel/  
J'ai essayer la methode automation mais ça m'extrait le formulaire entier  
 
 
 
Mon Bouton Chercher  

Code :
  1. Private Sub Commande112_Click()
  2. f = ""
  3. If Not IsNull(Me.Rréseau) And Me.Rréseau <> "" Then
  4. f = "Porteur LIKE ""*" & Me.Rréseau & "*"""
  5. End If
  6. If Not IsNull(Me.Rétat) And Me.Rétat <> "" Then
  7. If f <> "" Then
  8. f = f & " AND [Etat du dossier] = """ & Me.Rétat & """"
  9. Else
  10. f = "[Etat du dossier] = """ & Me.Rétat & """"
  11. End If
  12. End If
  13. If Not IsNull(Me.Rdate1) And Me.Rdate1 <> "" And Not IsNull(Me.Rdate2) And Me.Rdate2 <> "" Then
  14. If f <> "" Then
  15. f = f & " AND ([Date d'émission]) BETWEEN " & (Me.Rdate1) & " AND " & CLng(Me.Rdate2) & ""
  16. Else
  17. f = "CLng([Date d'émission]) BETWEEN " & CLng(Me.Rdate1) & " AND " & CLng(Me.Rdate2) & ""
  18. End If
  19. End If
  20. Me.Filter = f
  21. Me.FilterOn = True


ET pour le bouton extraction excel j'ai copié celui de "Automation" de cafeine en l'adaptant mais ça extrait tout  
 

Code :
  1. Private Sub Commande165_Click()
  2. Dim xlApp As Excel.Application
  3.     Dim xlSheet As Excel.Worksheet
  4.     Dim xlBook As Excel.Workbook
  5.     Dim I As Long, J As Long
  6.     Dim t0 As Long, t1 As Long
  7.    
  8.     t0 = Timer
  9.     Dim rec As Recordset
  10.    
  11.     Set rec = CurrentDb.OpenRecordset("Actions", dbOpenSnapshot)
  12.    
  13.     'Initialisations
  14.     Set xlApp = CreateObject("Excel.Application" )
  15.     Set xlBook = xlApp.Workbooks.Add
  16.  
  17.     'Ajouter une feuille de calcul
  18.     Set xlSheet = xlBook.Worksheets.Add
  19.     xlSheet.Name = "Tutoriel"
  20.  
  21.     ' le titre
  22.     '  écriture dans la cellule de ligne 1 et de colonne 1
  23.     xlSheet.Cells(1, 1) = "Export d'une table Access"
  24.  
  25.    
  26.     ' les entetes
  27.     '  .Fields(Index).Name renvoie le nom du champ
  28.     For J = 0 To rec.Fields.Count - 1
  29.         xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
  30.         ' Nous appliquons des enrichissements de format aux cellules
  31.         With xlSheet.Cells(2, J + 1)
  32.             .Interior.ColorIndex = 15
  33.             .Interior.Pattern = xlSolid
  34.             .Borders(xlEdgeBottom).LineStyle = xlContinuous
  35.             .Borders(xlEdgeBottom).Weight = xlThin
  36.             .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
  37.             .HorizontalAlignment = xlCenter
  38.         End With
  39.     Next J
  40.    
  41.     ' recopie des données à partir de la ligne 3
  42.     I = 3
  43.     Do While Not rec.EOF
  44.         For J = 0 To rec.Fields.Count - 1
  45.             ' .Fields(Index).Type renvoie le type du champ
  46.             '   si c'est un Texte (dbText) nous insérons "'" pour
  47.             '   qu'il soit reconnu par Excel comme du Texte
  48.             If rec.Fields(J).Type = dbText Then
  49.                 xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
  50.             Else                                                     '-----> j'ai un message d'erreur (erreur 1004 = erreur defini par l'application ou par l'objet)
  51.                 xlSheet.Cells(I, J + 1) = rec.Fields(J)              '----->  et pr afficher la date je dois mettre dbdate
  52.             End If
  53.         Next J
  54.         I = I + 1
  55.         rec.MoveNext
  56.     Loop
  57.  
  58.     ' code de fermeture et libération des objets
  59.     xlBook.SaveAs "C:\Documents and Settings\Nraymond\Bureau\Feuille.xls"
  60.     xlApp.Quit
  61.     rec.Close
  62.     Set rec = Nothing
  63.     Set xlSheet = Nothing
  64.     Set xlBook = Nothing
  65.     Set xlApp = Nothing
  66.     t1 = Timer
  67.     Debug.Print I & " enregistrements", Format(t1 - t0, "0" ) & " secondes"
  68. End Sub


 
 
Je vous remercie d'avance pour votre aide

mood
Publicité
Posté le 17-01-2008 à 17:53:57  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [ACCESS] Rqt multicritere export vers Excel

 

Sujets relatifs
Probleme pour recuprer une variable dans un code embed vers un swfmacro excel pour collage spécial dans Word
[Access] Importation de fichier texte et perte des espaces[Résolu] PB pour enregistrer des données dans la BSD ACCESS avec VBA
Lire et écrire dans une base de données SQL via Excel[Access - SQL] Count sur plusieurs tables
[Access] Modification d'une base de donnéesDate 2008-01-09 vers Mercredi 9 janvier 2008 ?
variables > include vers include 
Plus de sujets relatifs à : [ACCESS] Rqt multicritere export vers Excel


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR