Pb de sauvegarde lors de recuperation de donnée excel dans access

[Greg76]

Bonjour à tous,
Voici mon probleme:
Ce code permet de recupérer des données contenus dans un document excel vers un doument access. Il selectionne bien les données souhaiter et ouvre également le document access sauf que ces données ne sont pas sauvegarder. Si quelqu un peut trouver ou mon code cloche ca m aidera beaucoup.
Merci d avance à tous ceux qui jeterons un coup d oeil .

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\Bureau\greg\x.mdb")
' Ouverture de la table Factures
' Un objet Recordset représente les enregistrements d'une table
Set Rs1 = Db1.OpenRecordset("Articledevis", dbOpenTable)
' Détermination de la taille de la plage à envoyer vers Access
Set Plage = Worksheets("recap").Range("A13").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 Factures
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)
End With
Next
' Fermeture de la base Commandes.mdb
Db1.Close
End Sub

Private Sub CommandButton6_Click()

WritingWorksheetData_DAO

End Sub

 

[Greg76]

Je cherche toujours sans trouver de solution donc s il vous plais aider moi

 

[Greg76]

Bon b je vais posé ma question sur un autre forum en esperant que qq un pourra trouvé une solution a mon probleme car pour l instant persone ne m a repondu ici
Je viendrai quand meme verifier si un expert a reussi à trouver the solution
Merci A+

 

[@+Thierry]

Bonsoir Greg, le Forum

Une des premières qualité indispensable pour un bon développeur est la patience...

Par ailleurs, DAO est à mettre un peu à l'écart au profit de ADO pour les nouveaux développements...

Sinon Voici ton Code corrigé pour ajouter les données dans ta table Access en me basant sur un Travail de Michel_M sur ce Forum :

Sub WritingWorksheetData_DAO()
'@+Thierry Needs Reference to MicroSoft DAO 3.x Object Library

Dim Plage As Range
Dim Array1 As Variant
Dim x As Long
Dim Db1 As Database
Dim Rs1 As Recordset

Set Db1 = DBEngine.OpenDatabase("C:\Documents and Settings\Bureau\greg\x.mdb")
Set Rs1 = Db1.OpenRecordset("Articledevis", dbOpenDynaset)
Set Plage = Worksheets("Sheet1").Range("A13").CurrentRegion.Offset(1, 0)
Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
Array1 = Plage.Value

&nbps;&nbps;&nbps;For x = 1 To UBound(Array1, 1)
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;With Rs1
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.AddNew
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.Fields("NoChrono") = Array1(x, 1)
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.Fields("Référence") = Array1(x, 2)
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.Fields("PrixHT") = Array1(x, 3)
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.Fields("Remise") = Array1(x, 4)
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;.Update
&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;&nbps;End With
&nbps;&nbps;&nbps;Next

Rs1.Close
Db1.Close
End Sub

Bonne Soirée
@+Thierry

 

[@+Thierry]

Arf Sorry les Non-Breakable-Space m'ont joué un tour !

Option Explicit

Sub WritingWorksheetData_DAO()
'@+Thierry Needs Reference to MicroSoft DAO 3.x Object Library

Dim Plage As Range
Dim Array1 As Variant
Dim x As Long
Dim Db1 As Database
Dim Rs1 As Recordset

Set Db1 = DBEngine.OpenDatabase("C:\C\x.mdb")
Set Rs1 = Db1.OpenRecordset("Articledevis", dbOpenDynaset)
Set Plage = Worksheets("Sheet1").Range("A13").CurrentRegion.Offset(1, 0)
Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
Array1 = Plage.Value

   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

Rs1.Close
Db1.Close
End Sub

@+Thierry

 

[@+Thierry]

Hello les amis et amies.........

Bon et bien encore un coup foireux surtout après Lien supprimé


à croire (vraiment que les posts '"pressés" n'aboutissent à rien.....

On commencera à répondre après......... humm la 10èm....... allez, c'est Noël.... la 5èm demande !!!

Buesnas noches
@+Thierry