Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une
table access.
Cela fonctionne parfaitemement, le seul problème que je rencontre est le
suivant si j'envoie des données lorsque la table est vide il n'y a pas de
probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable()
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:\Qualité\BDD Qualité\BDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
With Sh
For Each r In .Range("A5:C300").Rows
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
Next
End With
Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte
Dim rs As Recordset
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
test = 0
Set MyDB = OpenDatabase("S:\Qualité\BDD Qualité\BDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0)
'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de
comparer
If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1
Loop
'si la clé est non prise alors on ajoute
If (test = 0) Then
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
End If
test = 0
Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type"
je pense qu'il y a un probleme dans le code mais je sais pas ou car il me
grise la ligne select ..from... et apres il me met en jaune "Sub
AjouterDesEnregistrementsAUneTable()"
Pouvez vous m'aider
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
FxM
Bonsoir,
Come l'a envisagé Denis dans un autre fil (ce n'est pas beau de réécrire la même question !), je jetterais un oeil dans Access pour accepter les doublons.
@+ FxM
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access, je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
Merci beaucoup
A+
Bonsoir,
Come l'a envisagé Denis dans un autre fil (ce n'est pas beau de réécrire
la même question !), je jetterais un oeil dans Access pour accepter les
doublons.
@+
FxM
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une
table access.
Cela fonctionne parfaitemement, le seul problème que je rencontre est le
suivant si j'envoie des données lorsque la table est vide il n'y a pas de
probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable()
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
With Sh
For Each r In .Range("A5:C300").Rows
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
Next
End With
Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte
Dim rs As Recordset
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0)
'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de
comparer
If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1
Loop
'si la clé est non prise alors on ajoute
If (test = 0) Then
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
End If
test = 0
Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type"
je pense qu'il y a un probleme dans le code mais je sais pas ou car il me
grise la ligne select ..from... et apres il me met en jaune "Sub
AjouterDesEnregistrementsAUneTable()"
Pouvez vous m'aider
Come l'a envisagé Denis dans un autre fil (ce n'est pas beau de réécrire la même question !), je jetterais un oeil dans Access pour accepter les doublons.
@+ FxM
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access, je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
Merci beaucoup
A+
michdenis
Bonjour lolo_bob2,
As-tu essayé quelque chose comme ceci :
Évidemment, tu dois ajouter la bibliothèque : Microsoft DAO 3.6 objects Librairy '-------------------------------------------- Sub ExporterVersAccess()
Dim bd As DAO.Database Dim Rst As DAO.Recordset
With Worksheets("Feuil1") .Range("B4:B" & .Range("B65536").End(xlUp).Row).Name = "Plage" End With
Set bd = OpenDatabase(ThisWorkbook.FullName, False, False, "excel 8.0")
bd.Execute "INSERT INTO toto IN 'C:ExcelComptoir.mdb' SELECT * FROM [Plage]" ThisWorkbook.Names("Plage").delete bd.Close Set bd = Nothing End Sub '--------------------------------------------
Salutations!
"lolo_bob2" a écrit dans le message de news:
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access, je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
Merci beaucoup
A+
Bonjour lolo_bob2,
As-tu essayé quelque chose comme ceci :
Évidemment, tu dois ajouter la bibliothèque :
Microsoft DAO 3.6 objects Librairy
'--------------------------------------------
Sub ExporterVersAccess()
Dim bd As DAO.Database
Dim Rst As DAO.Recordset
With Worksheets("Feuil1")
.Range("B4:B" & .Range("B65536").End(xlUp).Row).Name = "Plage"
End With
Set bd = OpenDatabase(ThisWorkbook.FullName, False, False, "excel 8.0")
bd.Execute "INSERT INTO toto IN 'C:ExcelComptoir.mdb' SELECT * FROM [Plage]"
ThisWorkbook.Names("Plage").delete
bd.Close
Set bd = Nothing
End Sub
'--------------------------------------------
Salutations!
"lolo_bob2" <lolobob2@discussions.microsoft.com> a écrit dans le message de news:
6ACC1E1A-90E1-4D13-94EF-9CD73BAE5E14@microsoft.com...
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une
table access.
Cela fonctionne parfaitemement, le seul problème que je rencontre est le
suivant si j'envoie des données lorsque la table est vide il n'y a pas de
probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable()
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
With Sh
For Each r In .Range("A5:C300").Rows
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
Next
End With
Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte
Dim rs As Recordset
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0)
'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de
comparer
If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1
Loop
'si la clé est non prise alors on ajoute
If (test = 0) Then
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
End If
test = 0
Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type"
je pense qu'il y a un probleme dans le code mais je sais pas ou car il me
grise la ligne select ..from... et apres il me met en jaune "Sub
AjouterDesEnregistrementsAUneTable()"
Pouvez vous m'aider
Évidemment, tu dois ajouter la bibliothèque : Microsoft DAO 3.6 objects Librairy '-------------------------------------------- Sub ExporterVersAccess()
Dim bd As DAO.Database Dim Rst As DAO.Recordset
With Worksheets("Feuil1") .Range("B4:B" & .Range("B65536").End(xlUp).Row).Name = "Plage" End With
Set bd = OpenDatabase(ThisWorkbook.FullName, False, False, "excel 8.0")
bd.Execute "INSERT INTO toto IN 'C:ExcelComptoir.mdb' SELECT * FROM [Plage]" ThisWorkbook.Names("Plage").delete bd.Close Set bd = Nothing End Sub '--------------------------------------------
Salutations!
"lolo_bob2" a écrit dans le message de news:
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access, je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
Merci beaucoup
A+
Ardus Petus
Voici ton code modifié pour accepter les mises à jour et les créations. Ne manquent plus que les suppressions.
Il faut au préalable créer un index sur le champ sap de ta table. CREATE UNIQUE INDEX SapNo ON produits (sap) WITH DISALLOW NULL ;
Cordialement, -- AP
'----------------------------------- Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As DAO.Database, MyTable As DAO.Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits", dbOpenTable) Set Sh = Worksheets("Feuil1")
With MyTable .Index = "sapNo" For r = 5 To Sh.Cells(Rows.Count, "A").End(xlUp).Row .Seek "=", Sh.Cells(r, "A") If .NoMatch Then .AddNew !sap = Sh.Cells(r, "A") !nom = Sh.Cells(r, "B") !prenom = Sh.Cells(r, "C") .Update Else .Edit !nom = Sh.Cells(r, "B") !prenom = Sh.Cells(r, "C") .Update End If Next r End With MyTable.Close MyDB.Close
End Sub '------------------------------
"lolo_bob2" a écrit dans le message de news:
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de
comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
Merci beaucoup
A+
Voici ton code modifié pour accepter les mises à jour et les créations.
Ne manquent plus que les suppressions.
Il faut au préalable créer un index sur le champ sap de ta table.
CREATE UNIQUE INDEX SapNo ON produits (sap) WITH DISALLOW NULL ;
Cordialement,
--
AP
'-----------------------------------
Sub AjouterDesEnregistrementsAUneTable()
Dim MyDB As DAO.Database, MyTable As DAO.Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits", dbOpenTable)
Set Sh = Worksheets("Feuil1")
With MyTable
.Index = "sapNo"
For r = 5 To Sh.Cells(Rows.Count, "A").End(xlUp).Row
.Seek "=", Sh.Cells(r, "A")
If .NoMatch Then
.AddNew
!sap = Sh.Cells(r, "A")
!nom = Sh.Cells(r, "B")
!prenom = Sh.Cells(r, "C")
.Update
Else
.Edit
!nom = Sh.Cells(r, "B")
!prenom = Sh.Cells(r, "C")
.Update
End If
Next r
End With
MyTable.Close
MyDB.Close
End Sub
'------------------------------
"lolo_bob2" <lolobob2@discussions.microsoft.com> a écrit dans le message de
news:6ACC1E1A-90E1-4D13-94EF-9CD73BAE5E14@microsoft.com...
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une
table access.
Cela fonctionne parfaitemement, le seul problème que je rencontre est le
suivant si j'envoie des données lorsque la table est vide il n'y a pas de
probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que
je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table
access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé
d'améliorer...
Sub AjouterDesEnregistrementsAUneTable()
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
With Sh
For Each r In .Range("A5:C300").Rows
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
Next
End With
Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte
Dim rs As Recordset
Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb")
Set MyTable = MyDB.OpenRecordset("produits")
Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0)
'Si la clé de ta ligne à ajouter est deja utilisée alors on stop
de
comparer
If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1
Loop
'si la clé est non prise alors on ajoute
If (test = 0) Then
With MyTable
.AddNew
!sap = Sh.Cells(r.Row, 1)
!nom = Sh.Cells(r.Row, 2)
!prenom = Sh.Cells(r.Row, 3)
.Update
End With
End If
test = 0
Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type"
je pense qu'il y a un probleme dans le code mais je sais pas ou car il me
grise la ligne select ..from... et apres il me met en jaune "Sub
AjouterDesEnregistrementsAUneTable()"
Pouvez vous m'aider
Voici ton code modifié pour accepter les mises à jour et les créations. Ne manquent plus que les suppressions.
Il faut au préalable créer un index sur le champ sap de ta table. CREATE UNIQUE INDEX SapNo ON produits (sap) WITH DISALLOW NULL ;
Cordialement, -- AP
'----------------------------------- Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As DAO.Database, MyTable As DAO.Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits", dbOpenTable) Set Sh = Worksheets("Feuil1")
With MyTable .Index = "sapNo" For r = 5 To Sh.Cells(Rows.Count, "A").End(xlUp).Row .Seek "=", Sh.Cells(r, "A") If .NoMatch Then .AddNew !sap = Sh.Cells(r, "A") !nom = Sh.Cells(r, "B") !prenom = Sh.Cells(r, "C") .Update Else .Edit !nom = Sh.Cells(r, "B") !prenom = Sh.Cells(r, "C") .Update End If Next r End With MyTable.Close MyDB.Close
End Sub '------------------------------
"lolo_bob2" a écrit dans le message de news:
Bonjour à tous,
Voila j'ai un code VBA qui permet d'envoyer des données d'excel vers une table access. Cela fonctionne parfaitemement, le seul problème que je rencontre est le suivant si j'envoie des données lorsque la table est vide il n'y a pas de probleme cela fonctionne. Si je rajoute une ligne au fichier excel et que je
renvoie les données, la nouvelle ligne ne s'inscrit pas dans la table access,
je pense que c parcequ'il touve des doublons !
j'ai un premier code celui de base et un second que j'ai essayé d'améliorer...
Sub AjouterDesEnregistrementsAUneTable() Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
With Sh For Each r In .Range("A5:C300").Rows With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With Next End With Set MyDB = Nothing: Set MyTable = Nothing: Set Sh = Nothing
End Sub
Le second code amélioré avec une conditionnel :
Sub AjouterDesEnregistrementsAUneTable()
Dim test As Byte Dim rs As Recordset Dim MyDB As Database, MyTable As Recordset, Sh As Worksheet test = 0
Set MyDB = OpenDatabase("S:QualitéBDD QualitéBDD Qualité.mdb") Set MyTable = MyDB.OpenRecordset("produits") Set Sh = Worksheets("Feuil1")
Set rs = "Select distinct sap from produits"
For Each r In .Range("A5:C300").Rows
Do While (rs.EOF = False And test = 0) 'Si la clé de ta ligne à ajouter est deja utilisée alors on stop de
comparer If (rs!sap = Sh.Cells(r.Row, 1)) Then test = 1 Loop 'si la clé est non prise alors on ajoute If (test = 0) Then With MyTable .AddNew !sap = Sh.Cells(r.Row, 1) !nom = Sh.Cells(r.Row, 2) !prenom = Sh.Cells(r.Row, 3) .Update End With End If test = 0 Next
End Sub
j'ai une erreur qui me dit "erreur de compilation incompatibilité de type" je pense qu'il y a un probleme dans le code mais je sais pas ou car il me grise la ligne select ..from... et apres il me met en jaune "Sub AjouterDesEnregistrementsAUneTable()" Pouvez vous m'aider
