J'aimerais avoir une macro dans Access pour importer des données dans
différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre
onglet et de faire la même chose.
Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un
autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il y
a une protection dans les fichiers "Excel".
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
3stone
Salut,
EricO wrote:
J'aimerais avoir une macro dans Access pour importer des données dans différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre onglet et de faire la même chose. Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il y a une protection dans les fichiers "Excel".
Pour faire cela, intéresse toi à l'automation ! Dans le cas présent, à l'automation d'Excel.
J'aimerais avoir une macro dans Access pour importer des données dans
différentes cellules sur un onglet. Ensuite de vérifier s'il y a un
autre onglet et de faire la même chose.
Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un
autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En
plus, il y a une protection dans les fichiers "Excel".
Pour faire cela, intéresse toi à l'automation !
Dans le cas présent, à l'automation d'Excel.
J'aimerais avoir une macro dans Access pour importer des données dans différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre onglet et de faire la même chose. Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il y a une protection dans les fichiers "Excel".
Pour faire cela, intéresse toi à l'automation ! Dans le cas présent, à l'automation d'Excel.
Sub Exemple_xl_2() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim L As Long Dim C As Integer
Dim sSql As String Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _ & " FROM Tbl_Poste;" Rst.Open sSql, CurrentProject.Connection, adOpenStatic If Rst.EOF Then Beep MsgBox "pas d'enregistrements" Exit Sub 'pas d'enregistrements Else Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'ou False (plus rapide dans le cas d'un grand tableau) Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur vierge ' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le cas d'un modèle ' Ecrire quelques valeurs Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans un modèle (conseillé)
With xlSheet For L = 1 To Rst.RecordCount For C = 1 To 2 .Cells(L, C) = Rst(C - 1) Next C If Not Rst.EOF Then Rst.MoveNext Next L End With MsgBox "fini ! " xlApp.Visible = True '(s'il avait été à false en début de procédure) ' Libérer les variables objet Rst.Close Set Rst = Nothing Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End If End Sub
"EricO" a écrit dans le message de news:
Bonjour à tous,
J'aimerais avoir une macro dans Access pour importer des données dans différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre onglet et de faire la même chose. Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il y a une protection dans les fichiers "Excel".
Merci de votre aide, très apprécié.
Érico
un petit exemple pour débuter :
Sub Exemple_xl_2()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim L As Long
Dim C As Integer
Dim sSql As String
Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _
& " FROM Tbl_Poste;"
Rst.Open sSql, CurrentProject.Connection, adOpenStatic
If Rst.EOF Then
Beep
MsgBox "pas d'enregistrements"
Exit Sub 'pas d'enregistrements
Else
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True 'ou False (plus rapide dans le cas d'un
grand tableau)
Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur
vierge
' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le
cas d'un modèle
' Ecrire quelques valeurs
Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans
un modèle (conseillé)
With xlSheet
For L = 1 To Rst.RecordCount
For C = 1 To 2
.Cells(L, C) = Rst(C - 1)
Next C
If Not Rst.EOF Then Rst.MoveNext
Next L
End With
MsgBox "fini ! "
xlApp.Visible = True '(s'il avait été à false en début de
procédure)
' Libérer les variables objet
Rst.Close
Set Rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
"EricO" <hahahar@videotron.ca> a écrit dans le message de news:
eQaP3F0uKHA.1796@TK2MSFTNGP02.phx.gbl...
Bonjour à tous,
J'aimerais avoir une macro dans Access pour importer des données dans
différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre
onglet et de faire la même chose.
Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un
autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il
y a une protection dans les fichiers "Excel".
Sub Exemple_xl_2() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim L As Long Dim C As Integer
Dim sSql As String Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _ & " FROM Tbl_Poste;" Rst.Open sSql, CurrentProject.Connection, adOpenStatic If Rst.EOF Then Beep MsgBox "pas d'enregistrements" Exit Sub 'pas d'enregistrements Else Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'ou False (plus rapide dans le cas d'un grand tableau) Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur vierge ' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le cas d'un modèle ' Ecrire quelques valeurs Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans un modèle (conseillé)
With xlSheet For L = 1 To Rst.RecordCount For C = 1 To 2 .Cells(L, C) = Rst(C - 1) Next C If Not Rst.EOF Then Rst.MoveNext Next L End With MsgBox "fini ! " xlApp.Visible = True '(s'il avait été à false en début de procédure) ' Libérer les variables objet Rst.Close Set Rst = Nothing Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End If End Sub
"EricO" a écrit dans le message de news:
Bonjour à tous,
J'aimerais avoir une macro dans Access pour importer des données dans différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre onglet et de faire la même chose. Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un autre..
Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il y a une protection dans les fichiers "Excel".
Merci de votre aide, très apprécié.
Érico
Erico
Un gros gros merci! Je vais regarder ça!
Salutations
"Blaise Cacramp" a écrit :
un petit exemple pour débuter :
Sub Exemple_xl_2() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim L As Long Dim C As Integer
Dim sSql As String Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _ & " FROM Tbl_Poste;" Rst.Open sSql, CurrentProject.Connection, adOpenStatic If Rst.EOF Then Beep MsgBox "pas d'enregistrements" Exit Sub 'pas d'enregistrements Else Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'ou False (plus rapide dans le cas d'un grand tableau) Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur vierge ' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le cas d'un modèle ' Ecrire quelques valeurs Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans un modèle (conseillé)
With xlSheet For L = 1 To Rst.RecordCount For C = 1 To 2 .Cells(L, C) = Rst(C - 1) Next C If Not Rst.EOF Then Rst.MoveNext Next L End With MsgBox "fini ! " xlApp.Visible = True '(s'il avait été à false en début de procédure) ' Libérer les variables objet Rst.Close Set Rst = Nothing Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End If End Sub
"EricO" a écrit dans le message de news:
> Bonjour à tous, > > J'aimerais avoir une macro dans Access pour importer des données dans > différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre > onglet et de faire la même chose. > Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un > autre.. > > Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il > y a une protection dans les fichiers "Excel". > > Merci de votre aide, très apprécié. > > Érico
.
Un gros gros merci! Je vais regarder ça!
Salutations
"Blaise Cacramp" a écrit :
un petit exemple pour débuter :
Sub Exemple_xl_2()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim L As Long
Dim C As Integer
Dim sSql As String
Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _
& " FROM Tbl_Poste;"
Rst.Open sSql, CurrentProject.Connection, adOpenStatic
If Rst.EOF Then
Beep
MsgBox "pas d'enregistrements"
Exit Sub 'pas d'enregistrements
Else
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True 'ou False (plus rapide dans le cas d'un
grand tableau)
Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur
vierge
' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le
cas d'un modèle
' Ecrire quelques valeurs
Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans
un modèle (conseillé)
With xlSheet
For L = 1 To Rst.RecordCount
For C = 1 To 2
.Cells(L, C) = Rst(C - 1)
Next C
If Not Rst.EOF Then Rst.MoveNext
Next L
End With
MsgBox "fini ! "
xlApp.Visible = True '(s'il avait été à false en début de
procédure)
' Libérer les variables objet
Rst.Close
Set Rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
"EricO" <hahahar@videotron.ca> a écrit dans le message de news:
eQaP3F0uKHA.1796@TK2MSFTNGP02.phx.gbl...
> Bonjour à tous,
>
> J'aimerais avoir une macro dans Access pour importer des données dans
> différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre
> onglet et de faire la même chose.
> Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un
> autre..
>
> Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il
> y a une protection dans les fichiers "Excel".
>
> Merci de votre aide, très apprécié.
>
> Érico
Sub Exemple_xl_2() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim L As Long Dim C As Integer
Dim sSql As String Dim Rst As New ADODB.Recordset
sSql = "SELECT Tbl_Poste.CP_Code, Tbl_Poste.CP_Localite" _ & " FROM Tbl_Poste;" Rst.Open sSql, CurrentProject.Connection, adOpenStatic If Rst.EOF Then Beep MsgBox "pas d'enregistrements" Exit Sub 'pas d'enregistrements Else Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True 'ou False (plus rapide dans le cas d'un grand tableau) Set xlBook = xlApp.Workbooks.Add 'dans le cas d'un classeur vierge ' ou Set xlBook = xlApp.Workbooks.Open("x:cheminnom.xlt") 'dans le cas d'un modèle ' Ecrire quelques valeurs Set xlSheet = xlBook.Worksheets("Feuil1") 'ou son vrai nom dans un modèle (conseillé)
With xlSheet For L = 1 To Rst.RecordCount For C = 1 To 2 .Cells(L, C) = Rst(C - 1) Next C If Not Rst.EOF Then Rst.MoveNext Next L End With MsgBox "fini ! " xlApp.Visible = True '(s'il avait été à false en début de procédure) ' Libérer les variables objet Rst.Close Set Rst = Nothing Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End If End Sub
"EricO" a écrit dans le message de news:
> Bonjour à tous, > > J'aimerais avoir une macro dans Access pour importer des données dans > différentes cellules sur un onglet. Ensuite de vérifier s'il y a un autre > onglet et de faire la même chose. > Dès rendu à la fin des onglets, de fermer le fichier et d'en ouvrir un > autre.. > > Le nombre d'onglets peut différencier d'un fichier à l'autre. En plus, il > y a une protection dans les fichiers "Excel". > > Merci de votre aide, très apprécié. > > Érico
.
Erico
Ça semble super.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit programme de 3 lignes, de prendre la cellule indiquer dans la colonne "Description" dans ma table? ex. H6 pour la première ligne et D10 pour la 2e, et ainsi de suite.... J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur une seule ligne dans ma table d'Access.
Érico
Ça semble super.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit
programme de 3 lignes, de prendre la cellule indiquer dans la colonne
"Description" dans ma table? ex. H6 pour la première ligne et D10 pour la 2e,
et ainsi de suite....
J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur une
seule ligne dans ma table d'Access.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit programme de 3 lignes, de prendre la cellule indiquer dans la colonne "Description" dans ma table? ex. H6 pour la première ligne et D10 pour la 2e, et ainsi de suite.... J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur une seule ligne dans ma table d'Access.
Érico
Blaise Cacramp
Ah, j'avais compris l'inverse. Oui, il est possible de lire des feuilles Excel, mais je suis assez réticent parce qu'une feuille, à moins qu'elle soit bien protégée, est trop facilement modifiable. Il n'y a pas dans Excel le respect de lintégrité d'un enregistrement.
S'il y a 50 cellules qui se suivent aussi harmonieusement que H6 et D10, cela va être dur de faire cela en 3 lignes, hein ?
Met ton problème plus à plat que ce soit bien compréhensif.
Blaise
"Erico" a écrit dans le message de news:
Ça semble super.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit programme de 3 lignes, de prendre la cellule indiquer dans la colonne "Description" dans ma table? ex. H6 pour la première ligne et D10 pour la 2e, et ainsi de suite.... J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur une seule ligne dans ma table d'Access.
Érico
Ah, j'avais compris l'inverse.
Oui, il est possible de lire des feuilles Excel, mais je suis assez réticent
parce qu'une feuille, à moins qu'elle soit bien protégée, est trop
facilement modifiable. Il n'y a pas dans Excel le respect de lintégrité
d'un enregistrement.
S'il y a 50 cellules qui se suivent aussi harmonieusement que H6 et D10,
cela va être dur de faire cela en 3 lignes, hein ?
Met ton problème plus à plat que ce soit bien compréhensif.
Blaise
"Erico" <Erico@discussions.microsoft.com> a écrit dans le message de news:
6E6F3C9D-AF6C-422E-A402-55DACA23D4A3@microsoft.com...
Ça semble super.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit
programme de 3 lignes, de prendre la cellule indiquer dans la colonne
"Description" dans ma table? ex. H6 pour la première ligne et D10 pour la
2e,
et ainsi de suite....
J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur
une
seule ligne dans ma table d'Access.
Ah, j'avais compris l'inverse. Oui, il est possible de lire des feuilles Excel, mais je suis assez réticent parce qu'une feuille, à moins qu'elle soit bien protégée, est trop facilement modifiable. Il n'y a pas dans Excel le respect de lintégrité d'un enregistrement.
S'il y a 50 cellules qui se suivent aussi harmonieusement que H6 et D10, cela va être dur de faire cela en 3 lignes, hein ?
Met ton problème plus à plat que ce soit bien compréhensif.
Blaise
"Erico" a écrit dans le message de news:
Ça semble super.
Est-ce possible, au lieu de faire une ligne par cellule, d'avoir un petit programme de 3 lignes, de prendre la cellule indiquer dans la colonne "Description" dans ma table? ex. H6 pour la première ligne et D10 pour la 2e, et ainsi de suite.... J'en ai pour environ 50 cellules à prendre par feuille et les mettre sur une seule ligne dans ma table d'Access.
Érico
Erico
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple.... _______________________________________________ Option Compare Database Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE 2010-2011.xls" Const EXCEL_APPLICATION = "Excel.Application" ' Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone As Range, Line As Range Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION) Set Dtb = CurrentDb() 'Importation vers Table Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011") 'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation On Error Resume Next ' Do While Not XlsRcs.EOF If XlsRcs!Numéro = Établissement Or Établissement = 0 Then 'Efface les vieux Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " & CStr(XlsRcs!Numéro) 'jjouvre le fichier excel Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE) 'Va dans l'onglet Set Wsh = Xls.Worksheets("Calendrier") Set Zone = Wsh.Range("Projets") For I = 0 To Zone.Rows.Count - 1 If Len(Zone.Cells(I + 1, 1)) > 0 Then TblRcs.AddNew TblRcs!Numéro = XlsRcs!Numéro For J = 0 To Zone.Columns.Count - 1 TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24) TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J + 1) Next J TblRcs.Update End If Next I XlsRcs.Edit XlsRcs!Pilote = Wsh.Cells(50, 3) XlsRcs!Téléphone = Wsh.Cells(52, 3) XlsRcs!Courriel = Wsh.Cells(54, 3) XlsRcs!Date = Wsh.Cells(56, 3) XlsRcs.Update Xls.Close False End If XlsRcs.MoveNext Loop
TblRcs.Close XlsRcs.Close Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
Next Fld End Sub
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple....
_______________________________________________
Option Compare Database
Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes
documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE
2010-2011.xls"
Const EXCEL_APPLICATION = "Excel.Application"
'
Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone As
Range, Line As Range
Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As
Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION)
Set Dtb = CurrentDb()
'Importation vers Table
Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011")
'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation
On Error Resume Next
' Do While Not XlsRcs.EOF
If XlsRcs!Numéro = Établissement Or Établissement = 0 Then
'Efface les vieux
Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " &
CStr(XlsRcs!Numéro)
'jjouvre le fichier excel
Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE)
'Va dans l'onglet
Set Wsh = Xls.Worksheets("Calendrier")
Set Zone = Wsh.Range("Projets")
For I = 0 To Zone.Rows.Count - 1
If Len(Zone.Cells(I + 1, 1)) > 0 Then
TblRcs.AddNew
TblRcs!Numéro = XlsRcs!Numéro
For J = 0 To Zone.Columns.Count - 1
TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24)
TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J + 1)
Next J
TblRcs.Update
End If
Next I
XlsRcs.Edit
XlsRcs!Pilote = Wsh.Cells(50, 3)
XlsRcs!Téléphone = Wsh.Cells(52, 3)
XlsRcs!Courriel = Wsh.Cells(54, 3)
XlsRcs!Date = Wsh.Cells(56, 3)
XlsRcs.Update
Xls.Close False
End If
XlsRcs.MoveNext
Loop
TblRcs.Close
XlsRcs.Close
Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields
XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple.... _______________________________________________ Option Compare Database Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE 2010-2011.xls" Const EXCEL_APPLICATION = "Excel.Application" ' Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone As Range, Line As Range Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION) Set Dtb = CurrentDb() 'Importation vers Table Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011") 'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation On Error Resume Next ' Do While Not XlsRcs.EOF If XlsRcs!Numéro = Établissement Or Établissement = 0 Then 'Efface les vieux Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " & CStr(XlsRcs!Numéro) 'jjouvre le fichier excel Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE) 'Va dans l'onglet Set Wsh = Xls.Worksheets("Calendrier") Set Zone = Wsh.Range("Projets") For I = 0 To Zone.Rows.Count - 1 If Len(Zone.Cells(I + 1, 1)) > 0 Then TblRcs.AddNew TblRcs!Numéro = XlsRcs!Numéro For J = 0 To Zone.Columns.Count - 1 TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24) TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J + 1) Next J TblRcs.Update End If Next I XlsRcs.Edit XlsRcs!Pilote = Wsh.Cells(50, 3) XlsRcs!Téléphone = Wsh.Cells(52, 3) XlsRcs!Courriel = Wsh.Cells(54, 3) XlsRcs!Date = Wsh.Cells(56, 3) XlsRcs.Update Xls.Close False End If XlsRcs.MoveNext Loop
TblRcs.Close XlsRcs.Close Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
Next Fld End Sub
Blaise Cacramp
Bon, tu as tout ce qu'il faut. Bonne continuation ! "Erico" a écrit dans le message de news:
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple.... _______________________________________________ Option Compare Database Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE 2010-2011.xls" Const EXCEL_APPLICATION = "Excel.Application" ' Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone As Range, Line As Range Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION) Set Dtb = CurrentDb() 'Importation vers Table Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011") 'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation On Error Resume Next ' Do While Not XlsRcs.EOF If XlsRcs!Numéro = Établissement Or Établissement = 0 Then 'Efface les vieux Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " & CStr(XlsRcs!Numéro) 'jjouvre le fichier excel Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE) 'Va dans l'onglet Set Wsh = Xls.Worksheets("Calendrier") Set Zone = Wsh.Range("Projets") For I = 0 To Zone.Rows.Count - 1 If Len(Zone.Cells(I + 1, 1)) > 0 Then TblRcs.AddNew TblRcs!Numéro = XlsRcs!Numéro For J = 0 To Zone.Columns.Count - 1 TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24) TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J + 1) Next J TblRcs.Update End If Next I XlsRcs.Edit XlsRcs!Pilote = Wsh.Cells(50, 3) XlsRcs!Téléphone = Wsh.Cells(52, 3) XlsRcs!Courriel = Wsh.Cells(54, 3) XlsRcs!Date = Wsh.Cells(56, 3) XlsRcs.Update Xls.Close False End If XlsRcs.MoveNext Loop
TblRcs.Close XlsRcs.Close Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
Next Fld End Sub
Bon, tu as tout ce qu'il faut.
Bonne continuation !
"Erico" <Erico@discussions.microsoft.com> a écrit dans le message de news:
FA3DF3BA-772B-42C2-A0EA-CAAAD095E307@microsoft.com...
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple....
_______________________________________________
Option Compare Database
Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes
documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE
2010-2011.xls"
Const EXCEL_APPLICATION = "Excel.Application"
'
Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone
As
Range, Line As Range
Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As
Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION)
Set Dtb = CurrentDb()
'Importation vers Table
Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011")
'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation
On Error Resume Next
' Do While Not XlsRcs.EOF
If XlsRcs!Numéro = Établissement Or Établissement = 0 Then
'Efface les vieux
Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " &
CStr(XlsRcs!Numéro)
'jjouvre le fichier excel
Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE)
'Va dans l'onglet
Set Wsh = Xls.Worksheets("Calendrier")
Set Zone = Wsh.Range("Projets")
For I = 0 To Zone.Rows.Count - 1
If Len(Zone.Cells(I + 1, 1)) > 0 Then
TblRcs.AddNew
TblRcs!Numéro = XlsRcs!Numéro
For J = 0 To Zone.Columns.Count - 1
TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24)
TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J +
1)
Next J
TblRcs.Update
End If
Next I
XlsRcs.Edit
XlsRcs!Pilote = Wsh.Cells(50, 3)
XlsRcs!Téléphone = Wsh.Cells(52, 3)
XlsRcs!Courriel = Wsh.Cells(54, 3)
XlsRcs!Date = Wsh.Cells(56, 3)
XlsRcs.Update
Xls.Close False
End If
XlsRcs.MoveNext
Loop
TblRcs.Close
XlsRcs.Close
Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields
XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
Bon, tu as tout ce qu'il faut. Bonne continuation ! "Erico" a écrit dans le message de news:
Pas de danger, les cellules seront toujours à la même place.
Voici un exemple.... _______________________________________________ Option Compare Database Option Explicit
Public Sub Import_demandes(Optional Établissement As Integer)
Const ROOT = "C:Documents and SettingsedufourMes documentsAccessTest_demandes", FILE = "-DEMANDE DE COMPLEMENTAIRE 2010-2011.xls" Const EXCEL_APPLICATION = "Excel.Application" ' Dim Exe As Excel.Application, Xls As Workbook, Wsh As Worksheet, Zone As Range, Line As Range Dim Dtb As Database, XlsRcs As Recordset, TblRcs As Recordset, I As Integer, J As Integer
Set Exe = CreateObject(EXCEL_APPLICATION) Set Dtb = CurrentDb() 'Importation vers Table Set XlsRcs = Dtb.OpenRecordset("Demandes_RFM_2010-2011") 'Set TblRcs = Dtb.OpenRecordset("PAPA_Réception")
' Debut de l importation On Error Resume Next ' Do While Not XlsRcs.EOF If XlsRcs!Numéro = Établissement Or Établissement = 0 Then 'Efface les vieux Dtb.Execute "Delete * FROM PAPA_Réception WHERE Numéro = " & CStr(XlsRcs!Numéro) 'jjouvre le fichier excel Set Xls = Exe.Workbooks.Open(ROOT & XlsRcs!Code & FILE) 'Va dans l'onglet Set Wsh = Xls.Worksheets("Calendrier") Set Zone = Wsh.Range("Projets") For I = 0 To Zone.Rows.Count - 1 If Len(Zone.Cells(I + 1, 1)) > 0 Then TblRcs.AddNew TblRcs!Numéro = XlsRcs!Numéro For J = 0 To Zone.Columns.Count - 1 TblRcs.Fields(`Conclusion`1).Value = Wsh.Cells(C24) TblRcs.Fields(J + 1).Value = Zone.Cells(I + 1, J + 1) Next J TblRcs.Update End If Next I XlsRcs.Edit XlsRcs!Pilote = Wsh.Cells(50, 3) XlsRcs!Téléphone = Wsh.Cells(52, 3) XlsRcs!Courriel = Wsh.Cells(54, 3) XlsRcs!Date = Wsh.Cells(56, 3) XlsRcs.Update Xls.Close False End If XlsRcs.MoveNext Loop
TblRcs.Close XlsRcs.Close Exe.Quit
For Each Fld In Dtb.TableDefs(XlsRcs.Name).Fields XlsRcs.Fields(Fld.Name) = Wsh.Cells(Fld.Description)
