Comment copier une feuille EXCEL sous ACCESS?

**PAULOM** · 26/04/2006, 16h23

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 :

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
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
Dim LigneCopiees As Long
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
 
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("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)
 
If DCount("*", "T31_Cumul_Nvx_clients_par_BG") > 0 Then
    Set Db = CurrentDb
     ' Copie dans feuille (nouvelle ou effacée)
    Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)
    Rs.MoveFirst
    LigneCopiees = XlSheet.Range("A1").CopyFromRecordset(Rs)
     ' Ferme les Var
    Rs.Close: Set Rs = Nothing
    Db.Close: Set Db = Nothing
Else
    MsgBox "Pas de données"
End If
 ' Ferme les Var
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

**Shansson** · 26/04/2006, 21h50

Bonjour,

N'y aurait-il pas déjà une erreur ici :

Code :

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

Set XlSheet = XlBook.Worksheets("NomFeuille")

?
J'aurais vu un

Code :

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

Set XlSheet = XlBook.Worksheets(NomFeuille)

**PAULOM** · 26/04/2006, 23h42

Envoyé par Shansson

Bonjour,

N'y aurait-il pas déjà une erreur ici :

Code :

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

Set XlSheet = XlBook.Worksheets(&quot;NomFeuille&quot;)

?
J'aurais vu un

Code :

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

Set XlSheet = XlBook.Worksheets(NomFeuille)

Exact je vais changer...

**PAULOM** · 27/04/2006, 12h11

Malheureusement ça ne fait rien de plus cette petite erreur!
Hormis ça vous ne voyez pas comment je peux faire pour simplement copier une feuille Excel?

**Shansson** · 27/04/2006, 13h53

Sous Excel, la syntaxe de la fonction .Copy est la suivante

Code :

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

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")

Tu dois pouvoir t'en inspirer

**PAULOM** · 27/04/2006, 15h01

Envoyé par Shansson

Sous Excel, la syntaxe de la fonction .Copy est la suivante

Code :

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

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")

Tu dois pouvoir t'en inspirer

J'ai essayer ça :
XlSheet.Worksheets(NomFeuille).Copy After:=XlSheet.Worksheets(S0)
Worksheets(NomFeuille).Copy After:=Worksheets(S0)

ça ne marche toujours pas

**Shansson** · 27/04/2006, 21h03

Je viens de tester :

Code :

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

XlSheet.Copy after:=XlBook.Worksheets(NomFeuille)

et ça marche parfaitement

Essaies de ton coté

**PAULOM** · 28/04/2006, 10h01

Envoyé par Shansson

Je viens de tester :

Code :

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

XlSheet.Copy after:=XlBook.Worksheets(NomFeuille)

et ça marche parfaitement

Essaies de ton coté

Merci j'ai résolu mon problème, voici le code pour ceux que ça interesse:

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
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
Dim LigneCopiees As Long
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
SemPrec = "S" & DatePart("ww", Date) - 2
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(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
'  Worksheets("S0").Copy After:=Worksheets("S14")
Set Db = CurrentDb
 
 ' Copie dans feuille (nouvelle ou effacée)
 
If DCount("*", "T31_Cumul_Nvx_clients_par_BG") > 0 Then
    Set Db = CurrentDb
     ' Copie dans feuille (nouvelle ou effacée)
    Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)
    For I = 0 To Rs.Fields.Count - 1
    XlSheet.Cells(1, I + 1) = Rs.Fields(I).Name
    Next I
    Rs.MoveFirst
    LigneCopiees = XlSheet.Range("A2").CopyFromRecordset(Rs)
     ' Ferme les Var
    Rs.Close: Set Rs = Nothing
    Db.Close: Set Db = Nothing
Else
    MsgBox "Pas de données"
End If
    'copie SXX dans S0
    Sheets(NomFeuille).Select
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Names.Add Name:="Semaine", RefersToR1C1:="=S16!R1C1:R111C7"
    Sheets(NomFeuille).Select
    Selection.Copy
    Sheets("S0").Select
    Range("A1:A1").Select
    ActiveSheet.Paste
    ActiveSheet.Paste
    'Copie la semaine précedente dans Semaine-1
    Sheets(SemPrec).Select
    Cells.Select
    Selection.Copy
    Sheets("Semaine S-1").Select
    Cells.Select
    ActiveSheet.Paste
    'Application.CutCopyMode = False
    Sheets("S0").Select
 ' Ferme les Var
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

Comment copier une feuille EXCEL sous ACCESS?

Access

Discussions similaires

Partager

Partager