Comment copier une feuille EXCEL sous ACCESS?

Comment copier une feuille EXCEL sous ACCESS? - VB/VBA/VBS - Programmation

Marsh Posté le 26-04-2006 à 16:24:33    

Bonjour à tous, voici mon problème je n'arrive pas à copier le contenu d'une feuille EXCEL dans une autre feuille EXCEL du meme classeur.
 
 
 
Je dois transférer une table ACCESS vers EXCEL, bon ça j'y arrive je transfère ma table ACCESS (toute les semaines) vers la feuille EXCEL (SXX) et cette feuille ainsi créer doit être copier dans le meme classeur dans la feuille S0, en gros je dois avoir 2 feuilles identiques dans le meme classeur mais sous 2 noms différents, et j'aimerais également mettre mes champs si possible.
 
 
 
Je met pour l'instant pour mon code si ça peut vous aider.
 
 
 
Je vous remercie d'avance pour votre aide.
 
 
 

Code :
  1. Option Compare Database
  3. Sub ExportTblAccessInExcel()
  5. Dim Db As DAO.Database
  7. Dim Rs As DAO.Recordset
  9. Dim Xlapp As Excel.Application
  11. Dim XlBook As Excel.Workbook
  13. Dim XlSheet As Excel.Worksheet
  15. Dim NomFeuille As String
  17. Dim LigneCopiees As Long
  19. On Error GoTo errOuvrirExcel
  21. Set Xlapp = GetObject(, "Excel.Application" )
  23. 'On Error GoTo oups:
  25. On Error GoTo 0
  27. Xlapp.Visible = True
  29. NomFeuille = "S" & DatePart("ww", Date) - 1
  33. Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx_clients_par_BG_2006_S14.xls" )
  37. If FeuilleExiste(NomFeuille, XlBook) Then
  39.   Set XlSheet = XlBook.Worksheets("NomFeuille" )
  41.    ' efface les données
  43.    XlSheet.Cells.Clear
  45. Else
  47.    ' Ajouter nouvelle feuille en dernière position
  49.    Set XlSheet = XlBook.Worksheets.Add(, XlBook.Worksheets(XlBook.Worksheets.Count - 2))
  51.    XlSheet.Name = NomFeuille
  55. End If
  59. Set Db = CurrentDb
  63. ' Copie dans feuille (nouvelle ou effacée)
  67. If DCount("*", "T31_Cumul_Nvx_clients_par_BG" ) > 0 Then
  69.     Set Db = CurrentDb
  71.      ' Copie dans feuille (nouvelle ou effacée)
  73.     Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)
  75.     Rs.MoveFirst
  77.     LigneCopiees = XlSheet.Range("A1" ).CopyFromRecordset(Rs)
  79.      ' Ferme les Var
  81.     Rs.Close: Set Rs = Nothing
  83.     Db.Close: Set Db = Nothing
  85. Else
  87.     MsgBox "Pas de données"
  89. End If
  91. ' Ferme les Var
  93. Set XlSheet = Nothing
  95. ' Sauve le fichier
  97. XlBook.Save
  99. 'XlBook.Close
  101. Set XlBook = Nothing
  103. Set Xlapp = Nothing
  105. Exit Sub
  107. errOuvrirExcel:
  109. 'Err 429 : Un serveur OLE Automation ne peut pas créer d'objet
  111. ' -> Excel n'est PAS encore ouvert.
  113. If Err = 429 Then
  115. Set Xlapp = CreateObject("Excel.Application" )
  117. Resume Next
  119. End If
  121. oups:
  123. MsgBox Err.Number & " - " & Err.Description
  125. End Sub
  127. Function FeuilleExiste(NomFeuille As String, Classeur As Excel.Workbook) As Boolean
  129. Dim errNum As Long, strName As String
  131.   errNum = 0: Err.Clear
  133.    On Error Resume Next
  135.    strName = Classeur.Worksheets(NomFeuille).Name
  137.    errNum = Err.Number
  139.    On Error GoTo 0
  141.    If errNum = 0 Then FeuilleExiste = True Else FeuilleExiste = False
  143. End Function


Reply

Marsh Posté le 26-04-2006 à 16:24:33   

Reply

Marsh Posté le 26-04-2006 à 16:42:27    

Dégrossis au macro recorder et optimise à la main

Reply

Marsh Posté le 26-04-2006 à 16:44:00    

Ou la!
Je suis désolé je comprend pas , je suis pas tres bon en VB....
 
Qu'est ce le macro recorder?
Optimise à la main?
 
Merci à toi

Reply

Marsh Posté le 26-04-2006 à 16:46:45    

Dans l'environnement Excel Outils/Macros/Nouvelle Macro

Reply

Marsh Posté le 26-04-2006 à 17:53:50    

Si application de transfert en VB6 et non en VBA
le lien http://www.vb-helper.com/howto_access_to_excel.html
te donne un code qui fonctionne correctement
et pour copier sur une 2eme feuille Excel tu peux coller
un excel_app.Sheets("Sheet2" ).Select puis remouliner le transfert de données. Le code est très bien commenté et suffisamment explicite pour le compléter et le modifier afin que l'ensemble ne génere pas de msg d'erreur
 
Je viens de le faire de façon bestiale à partir du lien et ça marche


Message édité par kiki29 le 26-04-2006 à 21:34:21
Reply

Marsh Posté le 27-04-2006 à 12:15:53    

Ouais mais bon c'est dommage que ce soit en anglais les commentaires.
 
Le code que tu m'a demandé c'est pour copier exactement?
Désolé mais j'ai du mal en VB lol
 
Merci de ton aide

Reply

Marsh Posté le 27-04-2006 à 13:17:02    

Si tu as une adresse email je t'envoie le programme modifié
mais ACHTUNG c'est bestial et pas propre au niveau codage
il faudrait redéfinir des fonctions etc mais ça marche
 
Pour l'Anglais c'est de l'Anglais basique et crois moi c'est indispensable
si tu veux avoir accès à certaines infos ou livres techniques


Message édité par kiki29 le 27-04-2006 à 13:26:21
Reply

Marsh Posté le 27-04-2006 à 13:30:33    

Je t'ai envoyé mon adresse par MP merci à toi

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed