PAULOM | Bonjour à tous,
voici mon problème je souhaite copier la table que j'exporte dans la feuille "SXX" dans la feuille "S0" de mon fichier excel, tout ça en VB.
Voici mon code:
Code :
- Option Compare Database
- Sub ExportTblAccessInExcel()
- Dim Db As DAO.Database
- Dim Rs As DAO.Recordset
- Dim Xlapp As Excel.Application
- Dim XlBook As Excel.Workbook
- Dim XlSheet As Excel.Worksheet
- Dim NomFeuille As String
- On Error GoTo errOuvrirExcel
- Set Xlapp = GetObject(, "Excel.Application" )
- 'On Error GoTo oups:
- On Error GoTo 0
- Xlapp.Visible = True
- NomFeuille = "S" & DatePart("ww", Date) - 1
- 'SemainePré = "S" & DatePart("ww", Date) - 2
- Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx_clients_par_BG_2006_S14.xls" )
- 'Set XlSheet = XlBook.Worksheets("S0" )
- 'Set XlSheet = XlBook.Worksheets("Semaine S-1" )
- If FeuilleExiste(NomFeuille, XlBook) Then
- Set XlSheet = XlBook.Worksheets("NomFeuille" )
-
- ' efface les données
- XlSheet.Cells.Clear
- Else
- ' Ajouter nouvelle feuille en dernière position
- Set XlSheet = XlBook.Worksheets.Add(, XlBook.Worksheets(XlBook.Worksheets.Count - 2))
- XlSheet.Name = NomFeuille
-
- End If
- Set Db = CurrentDb
- ' Copie dans feuille (nouvelle ou effacée)
- Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)
- XlSheet.Range("A1" ).CopyFromRecordset Rs
- Set XlSheet = Nothing
- ' remise au début car le 'CopyFromRecordset' ne le fait pas
- Rs.MoveFirst
- XlSheet.Range("A1" ).CopyFromRecordset Rs
- ' Ferme les Var
- Rs.Close: Set Rs = Nothing
- Db.Close: Set Db = Nothing
- Set XlSheet = Nothing
- ' Sauve le fichier
- XlBook.Save
- XlBook.Close
- Set XlBook = Nothing
- Set Xlapp = Nothing
- Exit Sub
- errOuvrirExcel:
- 'Err 429 : Un serveur OLE Automation ne peut pas créer d'objet
- ' -> Excel n'est PAS encore ouvert.
- If Err = 429 Then
- Set Xlapp = CreateObject("Excel.Application" )
- Resume Next
- End If
- oups:
- MsgBox Err.Number & " - " & Err.Description
- End Sub
- Function FeuilleExiste(NomFeuille As String, Classeur As Excel.Workbook) As Boolean
- Dim errNum As Long, strName As String
- errNum = 0: Err.Clear
- On Error Resume Next
- strName = Classeur.Worksheets(NomFeuille).Name
- errNum = Err.Number
- On Error GoTo 0
- If errNum = 0 Then FeuilleExiste = True Else FeuilleExiste = False
- End Function
|
Message édité par PAULOM le 25-04-2006 à 12:01:04
|
