G
Greg76
Guest
Bonjour,
J ai un gros soucis je veux exporter des données excel(2000) vers access j ai trouvé un code qui correspond à ma demande mais il plante(voir ligne encadré par les étoile et pourtant j ai bien activé la bibliothèque 3.6 DAO.
J ai absolument besoin d une reponse c urgent ca fait une semaine que j essaye et je suis bloqué.
Merci d'avance.
voici le code en question :
Sub WritingWorksheetData_DAO()
Dim Plage As Range
Dim Array1 As Variant
Dim x As Variant
Dim Db1 As Database
Dim Rs1 As Recordset
' Ouverture de la base de données
Set Db1 = DBEngine.Workspaces(0).OpenDatabase("C:\Documents and Settings\gluzman.PARIS\Bureau\greg\x.mdb")
' Ouverture de la table Factures
' Un objet Recordset représente les enregistrements d'une table
****************************************************
Set Rs1 = Db1.OpenRecordset("Articledevis", dbOpenDynaset)
****************************************************
'"ArticleDevis", Database)
' Détermination de la taille de la plage à envoyer vers Access
Set Plage = Worksheets("feuil1").Range("A1").CurrentRegion.Offset(1, 0)
Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
Plage.Select
' Lecture de la plage pour renvoyer une valeur contenant un tableau
Array1 = Plage.Value
' Ecriture des données depuis Excel vers les enregistrement de la table
For x = 1 To UBound(Array1, 1)
With Rs1
.AddNew
.Fields("NoChrono") = Array1(x, 1)
.Fields("Référence") = Array1(x, 2)
.Fields("PrixHT") = Array1(x, 3)
.Fields("Remise") = Array1(x, 4)
.Update
End With
Next
' Fermeture de la base Commandes.mdb
Db1.Close
' Effacement des données copiées vers la base (sauf les titres)
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
Selection.ClearContents
End Sub
____________________________________________________
Private Sub CommandButton6_Click()
WritingWorksheetData_DAO
End Sub
J ai un gros soucis je veux exporter des données excel(2000) vers access j ai trouvé un code qui correspond à ma demande mais il plante(voir ligne encadré par les étoile et pourtant j ai bien activé la bibliothèque 3.6 DAO.
J ai absolument besoin d une reponse c urgent ca fait une semaine que j essaye et je suis bloqué.
Merci d'avance.
voici le code en question :
Sub WritingWorksheetData_DAO()
Dim Plage As Range
Dim Array1 As Variant
Dim x As Variant
Dim Db1 As Database
Dim Rs1 As Recordset
' Ouverture de la base de données
Set Db1 = DBEngine.Workspaces(0).OpenDatabase("C:\Documents and Settings\gluzman.PARIS\Bureau\greg\x.mdb")
' Ouverture de la table Factures
' Un objet Recordset représente les enregistrements d'une table
****************************************************
Set Rs1 = Db1.OpenRecordset("Articledevis", dbOpenDynaset)
****************************************************
'"ArticleDevis", Database)
' Détermination de la taille de la plage à envoyer vers Access
Set Plage = Worksheets("feuil1").Range("A1").CurrentRegion.Offset(1, 0)
Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
Plage.Select
' Lecture de la plage pour renvoyer une valeur contenant un tableau
Array1 = Plage.Value
' Ecriture des données depuis Excel vers les enregistrement de la table
For x = 1 To UBound(Array1, 1)
With Rs1
.AddNew
.Fields("NoChrono") = Array1(x, 1)
.Fields("Référence") = Array1(x, 2)
.Fields("PrixHT") = Array1(x, 3)
.Fields("Remise") = Array1(x, 4)
.Update
End With
Next
' Fermeture de la base Commandes.mdb
Db1.Close
' Effacement des données copiées vers la base (sauf les titres)
With Selection.CurrentRegion
Intersect(.Cells, .Offset(1)).Select
End With
Selection.ClearContents
End Sub
____________________________________________________
Private Sub CommandButton6_Click()
WritingWorksheetData_DAO
End Sub