pb de code pour l export de donnée d excel vers access

[Greg76]

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

 

[Greg76]

y a personne qui peut m aider ????
le message d erreur est : "erreur d'execution '13' : incompatibilité de type"

 

[Greg76]

y a personne qui est assez doué pour m aider ou ce forume est réservé à un certain crépuscule dont je ne fait point partit ?
S il vous plait aidez moi !!!!!!!!!!!!!! c'est important c pour mon stage

 

[Greg76]

et bonne anniversaire au forum

 

[xx]

Bonjour Greg

Il est en effet difficile de trouver des rensignements sur Excel et Access.
Cependant il y'a qq années j'ai developpé une macro de traitement qui bascule des données de Excel vers Access. Tu la trouveras ci joint pour le cas ou cela peut aider. Elle est developpée pour la version 97.

a+

Sub expo_vers_access()
msg = "Voulez vous intégrer les CHEQUES dans la base Access CHEQUE ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
response = MsgBox(msg, Style)
If response = vbYes Then
Dim wk As workspace, db As database, modif_cheque As Recordset
Set wk = dbengine.workspaces(0)
Set db = wk.opendatabase("P:\BASE_ACCESS\OPE_TRESO.mdb")
Set modif_cheque = db.openrecordset("CHEQUE", dbopentable)


'Windows(3).Activate
Range("R1") = "=COUNTA(C[-17])"
n = Range("R1")
ntc = n - 1

For i = 2 To n
compte = Cells(i, 1)
flux = Cells(i, 2)
date_o = Cells(i, 3)
date_v = Cells(i, 4)
devise = Cells(i, 5)
mt_d = Cells(i, 6)
mt_FC = Cells(i, 8)
c_BUD = Cells(i, 10)
lib_cheque = Cells(i, 11)
date_m = Cells(i, 16)
'date op

j_date_o = Day(date_o)
m_date_o = Month(date_o)
a_date_o = Year(date_o)

If j_date_o < 13 Then
jc = m_date_o
mc = j_date_o
ac = a_date_o
date_o_c = jc & "/" & mc & "/" & ac
End If
If j_date_o > 12 Then
jc = j_date_o
mc = m_date_o
ac = a_date_o
date_o_c = jc & "/" & mc & "/" & ac
End If
date_op = DateValue(date_o_c)


'date valeur

j_date_v = Day(date_v)
m_date_v = Month(date_v)
a_date_v = Year(date_v)

If j_date_v < 13 Then
jcv = m_date_v
mcv = j_date_v
acv = a_date_v
date_v_c = jcv & "/" & mcv & "/" & acv
End If
If j_date_v > 12 Then
jcv = j_date_v
mcv = m_date_v
acv = a_date_v
date_v_c = jcv & "/" & mcv & "/" & acv
End If
date_va = DateValue(date_v_c)

'date MODIF

j_date_m = Day(date_m)
m_date_m = Month(date_m)
a_date_m = Year(date_m)

If j_date_m < 13 Then
jcm = m_date_m
mcm = j_date_m
acm = a_date_m
date_m_c = jcm & "/" & mcm & "/" & acm
End If
If j_date_m > 12 Then
jcm = j_date_m
mcm = m_date_m
acm = a_date_m
date_m_c = jcm & "/" & mcm & "/" & acm
End If
date_mo = DateValue(date_m_c)


modif_cheque.addnew
modif_cheque("Compte") = compte
modif_cheque("Flux") = flux
modif_cheque("Date_op") = date_op
modif_cheque("Date Valeur") = date_va
modif_cheque("Date_Maj") = date_mo
modif_cheque("Devise") = devise
modif_cheque("Montant en Devise") = mt_d
modif_cheque("Montant en Frf") = mt_FC
modif_cheque("BUD") = c_BUD
modif_cheque("Etat") = "EN COURS"
modif_cheque("Libelles") = lib_cheque

modif_cheque.Update


Next i
db.Close
End If
mm = "TRAITEMENT O.K. POUR " & ntc & " ECRITURE "
MMM = MsgBox(mm)
Workbooks("relation_excel_access.XLS").Close
End Sub

 

[Willy]

Salut

essaye dbOpenTable au lieu de dbOpenDynaset

Bon courage

 

[Greg76]

merci willy et xx
y a plus le bugue mais je reussi pas à sauvegarder mes données dans la table ce qui et quand meme un gros soucis
Si vous avez une soluce merci et encore merci pour votre reponse ca fait plaisir de pouvoir compter sur l aide d'autrui
je continue a cherché de mon coté

 

[Greg76]

willy merci pour ton code mais pourrait tu m indiquer comment tu designe les champs de tes tables car je suis un peu dans le flou pour comprendre.
je te remercie d avance

 

[Greg76]

euh dslé c etait pas willy mais le code de xx
mais si qq 1 d autre peut m expliqué veut bien
rappel:je ne reussi pas a garder les valeur selectionné dans ma table
mais sinon la table s ouvre se referme et les valeur sont bien selectionner encore un ptit détailles et c bon
aidé moi s il vous plait