Exporter une table Access vers EXCEL

Bonjour,

ce pourrait être cette ligne !

xlApp.ActiveWorkbook.Sheets(1).Copy After:=xlApp.ActiveWorkbook.Sheets(IndicateursSemaine![Semaine] + 1)

Je crois comprendre ce que vous tenter de faire, si vous étiez
sous VBA pas de problème, mais en VBS certaines options ne
réponde pas toujours.

si cette syntaxe ne fonctionne pas !
xlApp.ActiveWorkbook.Sheets(1).Copy After:=Sheets(IndicateursSemaine![Semaine] + 1)

alors contourné ce problème en placant une feuille masqué et

xlApp.ActiveWorkbook.Sheets("Robot").Visible = True
xlApp.ActiveWorkbook.Sheets("Robot").Select
xlApp.ActiveWorkbook.Sheets(1).Copy Before:=Sheets("Robot")
xlApp.ActiveWorkbook.Sheets("Robot").Visible = False

autre suggestion, déclaré un objet BooK, exemple

dim xlBK
Set xlBK = xlApp.ActiveWorkBook

Lupin

Bonjour,

alors voilà, comme je vous ai dit pour ma part je vois une confusion
ici :

Dim Xlapp As Excel.Application
Set Xlapp = GetObject(, "Excel.Application")

je recommande plutôt comme ceci :

Dim Xlapp As Excel.Application
Set Xlapp = New Excel.Application

bien entendu, il faut faudra charger la référence
"Microsoft Excel 1X Object Library", sinon vous
utiliser des objets de scripting qui différent de ceux
proposé sous VBA.

j'ai modifié votre code pour le comprendre, et le rendre fonctionnel !

voici ce que ça me donne :

Option Compare Database
Option Explicit
'

Dim Xlapp As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
'

Public Sub ExporteVersExcel()

Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim NomFeuille As String

    On Error GoTo Err_ExporteVersExcel
    
    Set Xlapp = New Excel.Application
    'Set Xlapp = GetObject(, "Excel.Application")
    'On Error GoTo oups:
    On Error GoTo 0
    Xlapp.Visible = True
    NomFeuille = "S07"
    'NomFeuille = "S" & DatePart("ww", Date)
    Set XlBook = Xlapp.Workbooks.Open("C:\Nvx.xls")
    
    If FeuilleExiste(NomFeuille, XlBook.Name) Then
        Set XlSheet = XlBook.Worksheets("S07")
        ' 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))
        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)
    Set Rs = Db.OpenRecordset("Requête Liste Titre")
    XlSheet.Range("A1").CopyFromRecordset Rs
    Set XlSheet = Nothing
    ' remise au début car le 'CopyFromRecordset' ne le fait pas
    Rs.MoveFirst
    '??? une 2ième foiS ??? XlSheet.Range("A1").CopyFromRecordset Rs
    ' Ferme les Var
    
    'Rs.Close '(lancer d'un form déjà aménagé pour moi)
    Set Rs = Nothing
    'Db.Close '(lancer d'un form déjà aménagé pour moi)
    Set Db = Nothing
    
    Set XlSheet = Nothing
    ' Sauve le fichier
    XlBook.Save
    'XlBook.Close
    Set XlBook = Nothing
    Set Xlapp = Nothing

'lupin*****************
Exit_ExporteVersExcel:
    '...
    Exit Sub

Err_ExporteVersExcel:
    
    '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
    Resume Exit_ExporteVersExcel
    
End Sub
'

Function FeuilleExiste(NomFeuille As String, Classeur As String) As Boolean

    Dim Feuille As Object
    
    FeuilleExiste = False
    For Each Feuille In Xlapp.Worksheets
        If (Feuille.Name = NomFeuille) Then
            FeuilleExiste = True
        End If
    Next Feuille

End Function
'

Lupin

Merci pour ton aide lupin, j'ai changé tout le code pour eviter les mauvaises manips entre les differents VB, voici le nouveau:

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



On Error GoTo errOuvrirExcel
Set Xlapp = GetObject(, "Excel.Application")

On Error GoTo oups:

Xlapp.Visible = True


Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx clients par BG 2006 S14.xls")
Set XlSheet = XlBook.Sheets("S0")

' efface les données
XlSheet.Cells.Clear

Set Db = CurrentDb

' Copie dans S0
Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)
XlSheet.Range("A1").CopyFromRecordset Rs

Set XlSheet = Nothing

' Ajout de la feuille
Set XlSheet = XlBook.Worksheets.Add
XlSheet.Name = "S15"

' 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

Mais j'ai un second souci,lorsque l'on crée la feuille "S15" car cette feuille existe déja en faite sur Excel mais elle est vierge car les données ne sont pas encore rentrées. C'est exactement ce que je veux faire, pas la peine de recréer une autre feuille "S15" puisqu'elle est deja existante tu vois?
Je veux juste copier cette table dans la feuille de mon choix.

Merci beaucoup j'espere que vous m'avez bien compris.

Bonne journée à vous.

plutot que de faire add tu selectionne la feuille:

Set XlSheet = XlBook.Sheets("S15")

+ Ca pour la selectionner et l'afficher en premier :

XlSheet.Select

Woila

Bonjour,

je crois qu'il y a confusion ici !

Dim Xlapp As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet

Ces variables sont utilisées ici comme dans l'instruction :

Set Xlapp = GetObject(, "Excel.Application")

et la fonction "GetObject" est une instruction qui s'adresse
aux objets de "scripting", vous êtes dans un environnement
VBA, mais lorsque que vous manipulé Xlapp, celui-ci est un
objet de "scripting", dans ces conditions certaines instructions
sont plus limités pour les paramêtres.

Lupin

Faux, je dis faux... lol

En faite, non monsieur lupin, étant donnée que la variable est déclarée comme Excel.Application

re:

c'est justement le fait que cette variable soit déclaré comme objet !

la méthode GetObject* est défini comme fonction de scripting,
d'après moi peu importe la variable qui va l'accepter cela sera
quand même un objet de scripting, et avec ce type de crochet
j'ai rencontré plusieurs problèmes.

je n'arrive pas à modifier ce lien, il attérit sur la methode
RegRead, il suffit de visualiser la liste à gauche pour y trouver la méthode GetObject !

* https://docs.microsoft.com/en-us/

Lupin

bon...

ceci dit, il y a peu être un autre chemin que je ne connais point !

sachant que GetObject est un objet de scripting, j'ai toujours
déclaré sous VBA les variables en type Variant pour toutes les
variables utilisant les objets de "scripting".

Dim Xlapp As Excel.Application
Set Xlapp = GetObject(, "Excel.Application")

en VBS sous VBA, j'écris :

Dim Xlapp As Variant
Set Xlapp = GetObject(, "Excel.Application")

en VBS toutes les variables sont de Type Variant de façon native.

Lupin

Merci pour votre aide j'ai fait refait le code le voici:

[b]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)

Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx_clients_par_BG_2006_S14.xls")
If FeuilleExiste(NomFeuille, XlBook) Then
Set XlSheet = XlBook.Worksheets("S0")
' 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))
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
[/b]

Mais j'ai un petit problème voici l'erreur:

Il me met cette erreur:
Erreur 91- Varaible objet ou variable de bloc with non définie

Je pense que c'est dans cette partie :
[b]' 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[/b]

Merci beaucoup pour votre aide lupin, je vous tiens au courant...

Merci LUPIN je me suis servis de votre code pour faire fonctionner le mien.

C'est vraiment gentil de votre part!