Bonjour =E0 tous, voici mon probl=E8me je n'arrive pas =E0 copier le
contenu d'une feuille EXCEL dans une autre feuille EXCEL du meme
classeur.
Je dois transf=E9rer une table ACCESS vers EXCEL, bon =E7a j'y arrive je
transf=E8re ma table ACCESS (toute les semaines) vers la feuille EXCEL
(SXX) et cette feuille ainsi cr=E9er doit =EAtre 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=E9rents, et
j'aimerais =E9galement mettre mes champs si possible.
Je met pour l'instant pour mon code si =E7a peut vous aider.
Je vous remercie d'avance pour votre aide.
[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
Dim LigneCopiees As Long
On Error GoTo errOuvrirExcel
Set Xlapp =3D GetObject(, "Excel.Application")
'On Error GoTo oups:
On Error GoTo 0
Xlapp.Visible =3D True
NomFeuille =3D "S" & DatePart("ww", Date) - 1
Set XlBook =3D Xlapp.Workbooks.Open("C:\Documents and
Settings\A4382\Bureau\stage\Nvx_clients_par_BG_2006_S14.xls")
If FeuilleExiste(NomFeuille, XlBook) Then
Set XlSheet =3D XlBook.Worksheets("NomFeuille")
' efface les donn=E9es
XlSheet.Cells.Clear
Else
' Ajouter nouvelle feuille en derni=E8re position
Set XlSheet =3D XlBook.Worksheets.Add(,
XlBook.Worksheets(XlBook.Worksheets.Count - 2))
XlSheet.Name =3D NomFeuille
End If
Set Db =3D CurrentDb
' Copie dans feuille (nouvelle ou effac=E9e)
If DCount("*", "T31_Cumul_Nvx_clients_par_BG") > 0 Then
Set Db =3D CurrentDb
' Copie dans feuille (nouvelle ou effac=E9e)
Set Rs =3D Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", ,
dbOpenForwardOnly)
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. ...
Bonjour, Paulom
As-tu essayé de faire ce que tu décris dans Excel en utilsant l'enregistreur de macros ? Le code écrit dans Access en utilisant Automation devrait être très proche, voir identique. Quand à "mettre mes champs si possible", je ne comprends pas ce que tu souhaites. Peux-tu être plus précis ?
Bonne continuation
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.
...
Bonjour, Paulom
As-tu essayé de faire ce que tu décris dans Excel en utilsant l'enregistreur
de macros ?
Le code écrit dans Access en utilisant Automation devrait être très proche,
voir identique.
Quand à "mettre mes champs si possible", je ne comprends pas ce que tu
souhaites. Peux-tu être plus précis ?
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. ...
Bonjour, Paulom
As-tu essayé de faire ce que tu décris dans Excel en utilsant l'enregistreur de macros ? Le code écrit dans Access en utilisant Automation devrait être très proche, voir identique. Quand à "mettre mes champs si possible", je ne comprends pas ce que tu souhaites. Peux-tu être plus précis ?
Bonne continuation
PAULOM
Mais le problème si je fais sous Excel, il faut que les feuilles aient toujours le meme nom or celui des "sxx" change automatiquement toutes les semaines...
Les champs signifient que j'aimerais bien mettre lors du transfert les champs des tables access car j'ai rien^^
Merci beaucoup pour ton aide
Mais le problème si je fais sous Excel, il faut que les feuilles aient
toujours le meme nom or celui des "sxx" change automatiquement toutes
les semaines...
Les champs signifient que j'aimerais bien mettre lors du transfert les
champs des tables access car j'ai rien^^
Mais le problème si je fais sous Excel, il faut que les feuilles aient toujours le meme nom or celui des "sxx" change automatiquement toutes les semaines...
Les champs signifient que j'aimerais bien mettre lors du transfert les champs des tables access car j'ai rien^^
Merci beaucoup pour ton aide
Gilles MOUGNOZ
Mais le problème si je fais sous Excel, il faut que les feuilles aient toujours le meme nom or celui des "sxx" change automatiquement toutes les semaines... Les champs signifient que j'aimerais bien mettre lors du transfert les champs des tables access car j'ai rien^^ Merci beaucoup pour ton aide
On ne s'est pas compris... Je te disais simplement de le faire sur Excel pour, dans un premier temps, voir quel code VBA était généré et ,dans un deuxième temps, reporter ce code dans Access. Ceci dit, le VBA d'Excel n'est pas différent de celui d'Access, il y a seulement des objets et conteneurs spécifiques à chacun (Forms, Reports, ... pour Access, WorkBooks, WorkSheets, ... pour Excel). Pour ton autre question, je ne suis pas sûr. Il est tout à fait possible de faire une boucle sur la définition des champs du recordset mais je ne sais pas s'ils seront dans le bon ordre. Cela devrait donner ceci:
Dim ChampRs As Field Dim NumLigne As Long Dim NumColonne As Long For Each ChampRs In Rs.Fields ' copie du nom de champ dans la cellule de la ligne NumLigne ' de la colonne NumColonne XlSheet.Cells(NumLigne,NumColonne) = ChampRs.Name Next ChampRs
Je te laisse tester. N'oublie pas d'initialiser et d'incrémenter NumLigne ou NumColonne dans la boucle.
Bonne continuation
Mais le problème si je fais sous Excel, il faut que les feuilles aient
toujours le meme nom or celui des "sxx" change automatiquement toutes
les semaines...
Les champs signifient que j'aimerais bien mettre lors du transfert les
champs des tables access car j'ai rien^^
Merci beaucoup pour ton aide
On ne s'est pas compris...
Je te disais simplement de le faire sur Excel pour, dans un premier temps,
voir quel code VBA était généré et ,dans un deuxième temps, reporter ce code
dans Access.
Ceci dit, le VBA d'Excel n'est pas différent de celui d'Access, il y a
seulement des objets et conteneurs spécifiques à chacun (Forms, Reports, ...
pour Access, WorkBooks, WorkSheets, ... pour Excel).
Pour ton autre question, je ne suis pas sûr. Il est tout à fait possible de
faire une boucle sur la définition des champs du recordset mais je ne sais
pas s'ils seront dans le bon ordre.
Cela devrait donner ceci:
Dim ChampRs As Field
Dim NumLigne As Long
Dim NumColonne As Long
For Each ChampRs In Rs.Fields
' copie du nom de champ dans la cellule de la ligne NumLigne
' de la colonne NumColonne
XlSheet.Cells(NumLigne,NumColonne) = ChampRs.Name
Next ChampRs
Je te laisse tester. N'oublie pas d'initialiser et d'incrémenter NumLigne ou
NumColonne dans la boucle.
Mais le problème si je fais sous Excel, il faut que les feuilles aient toujours le meme nom or celui des "sxx" change automatiquement toutes les semaines... Les champs signifient que j'aimerais bien mettre lors du transfert les champs des tables access car j'ai rien^^ Merci beaucoup pour ton aide
On ne s'est pas compris... Je te disais simplement de le faire sur Excel pour, dans un premier temps, voir quel code VBA était généré et ,dans un deuxième temps, reporter ce code dans Access. Ceci dit, le VBA d'Excel n'est pas différent de celui d'Access, il y a seulement des objets et conteneurs spécifiques à chacun (Forms, Reports, ... pour Access, WorkBooks, WorkSheets, ... pour Excel). Pour ton autre question, je ne suis pas sûr. Il est tout à fait possible de faire une boucle sur la définition des champs du recordset mais je ne sais pas s'ils seront dans le bon ordre. Cela devrait donner ceci:
Dim ChampRs As Field Dim NumLigne As Long Dim NumColonne As Long For Each ChampRs In Rs.Fields ' copie du nom de champ dans la cellule de la ligne NumLigne ' de la colonne NumColonne XlSheet.Cells(NumLigne,NumColonne) = ChampRs.Name Next ChampRs
Je te laisse tester. N'oublie pas d'initialiser et d'incrémenter NumLigne ou NumColonne dans la boucle.
Bonne continuation
PAULOM
Merci beaucoup pour ta reponse je teste tout ça ce soir et je te dit mon avancement! Merci à toi
Merci beaucoup pour ta reponse je teste tout ça ce soir et je te dit
mon avancement!
Merci à toi
Merci beaucoup pour ta reponse je teste tout ça ce soir et je te dit mon avancement! Merci à toi
PAULOM
Voila ça marche impec:
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 SettingsA4382BureaustageNvx_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
Voila ça marche impec:
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
SettingsA4382BureaustageNvx_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
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 SettingsA4382BureaustageNvx_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
