Discussion :

[Quentin76120]

Bonjour à tous,

Pour une mission de mon apprentissage chez un équipementier automobile, je dois créer une BDD Access.
Il me reste un seul point qui me bloque pour terminer cette BDD.
J'ai créer un formulaire où l'utilisateur choisi un type de produit et un produit dans des listes déroulantes. Ensuite j'ai créer un bouton sur lequel, lorsque l'on clique dessus, cela ouvre un fichier excel et je voudrais que cela copie les enregistrements contenant le produit choisi dans la liste à la suite les uns des autres dans le fichier Excel.

Voici mon code pour le moment :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub Commande32_Click()
 
Dim appexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim i As Integer
i = 7
Set rstMecanismes = CurrentDb.OpenRecordset("CopieMecanismes")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "P:\RetD PRODUITS\1 - ACQUISITIONS\05- Generics Products\13- Technical Datasheet\Fichier FTL - Copie.xls", "D:\"
 
Set appexcel = CreateObject("Excel.Application")
appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("D:\Fichier FTL - Copie.xls")
 
appexcel.Sheets("FTL").Select
 
DoCmd.FindRecord Me.cmbProduit1, acEntire, False, , True, acAll
 
If Me.CurrentRecord < Me.Recordset.RecordCount Then
 
appexcel.Cells(i, 10) = rstMecanismes![Type de produit] & ":" & " " & rstMecanismes![Produit]
appexcel.Cells(i, 11) = rstMecanismes![Criteria] & ":" & " " & rstMecanismes![Performances requises] & " " & rstMecanismes![Unit] & "  " & rstMecanismes![Comments]
appexcel.Cells(i, 1) = rstMecanismes![Phase de vie FTL]
appexcel.Cells(i, 2) = rstMecanismes![Fonction FTL]
i = i + 1
Me.Recordset.MoveNext
 
End If
 
 
End Sub

Pour le moment, le fichier Excel s'ouvre, je n'ai pas de message d'erreur d'Access mais il me copie le premier enregistrement de ma table dans EXCEL alors que le produit renseigné dans la liste déroulante [cmbProduit1] n'est pas celui du premier enregistrement.

Pouvez-vous m'aider SVP ? J'ai essayé beaucoup de choses mais je ne trouve pas la solution :/

[tee_grandbois]

Bonjour,
Si c'est dans la table CopieMecanismes que tu va chercher les enregistrements, il faut filtrer avec ta sélection (type de produit) et ensuite parcourir les enregistrements de la table et pas ceux du formulaire.
- sélection des enregistrements dans la table :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim appexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim rstMecanismes as recordSet
Dim fso as object
Dim i As Integer
 
Set rstMecanismes = CurrentDb.OpenRecordset("select * from CopieMecanismes where [Type de produit]=" & Me.cmbProduit1)

- lecture des enregistrements sélectionnés:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
' Si on a des enregistrements on ouvre Excel et le fichier
if not rstMecanismes.EOF Then
    i = 7
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile "P:\RetD PRODUITS\1 - ACQUISITIONS\05- Generics Products\13- Technical Datasheet\Fichier FTL - Copie.xls", "D:\"
    Set appexcel = CreateObject("Excel.Application")
    appexcel.Visible = True
    Set wbexcel = appexcel.Workbooks.Open("D:\Fichier FTL - Copie.xls")
 
    appexcel.Sheets("FTL").Select
' lecture des enregistrements sélectionnés
    With rstMecanismes
        Do Until .EOF
            appexcel.Cells(i, 10) = ![Type de produit] & ":" & " " & ![Produit]
            appexcel.Cells(i, 11) = ![Criteria] & ":" & " " & ![Performances requises] & " " & ![Unit] & "  " & ![Comments]
            appexcel.Cells(i, 1) = ![Phase de vie FTL]
            appexcel.Cells(i, 2) = ![Fonction FTL]
            i = i + 1
            .MoveNext 
        Loop
    End With
 
End if

[Quentin76120]

Bonjour tee_grandbois

Tout d'abord merci pour ton aide,
J'ai essayé le code que tu m'as envoyé mais Access me renvoie une erreur "Erreur d’exécution '3061'" (Trop peu de paramètres. 1 attendu).
Cette erreur intervient sur la ligne de code suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rstMecanismes = CurrentDb.OpenRecordset("SELECT * FROM CopieMecanismes WHERE Produit = Me.cmbProduit1")

Petite precision : - cmbProduit1 correspond à la liste déroulante de choix du produit dans mon formulaire
- Produit est mon champs de ma table CopieMecanismes

Aurais-tu une solution ?

Merci d'avance

[Quentin76120]

Re Bonjour,

Juste pour vous signaler que j'ai résolu le problème, il fallait ajouter chr (34) avant et après mon Me.cmbProduit1 car la valeur qu'il renvoyait était entre guillemets.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub Commande32_Click()
 
 
Dim appexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim rstMecanismes As DAO.Recordset
Dim oDb As DAO.Database
Dim fso As Object
Dim i As Integer
 
 
Set oDb = CurrentDb
Set rstMecanismes = oDb.OpenRecordset("SELECT * FROM CopieMecanismes WHERE [Produit]=" & Chr(34) & Me.cmbProduit1 & Chr(34))
 
' Si on a des enregistrements on ouvre Excel et le fichier
If Not rstMecanismes.EOF Then
    i = 7
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile "P:\RetD PRODUITS\1 - ACQUISITIONS\05- Generics Products\13- Technical Datasheet\Fichier FTL - Copie.xls", "D:\"
    Set appexcel = CreateObject("Excel.Application")
    appexcel.Visible = True
    Set wbexcel = appexcel.Workbooks.Open("D:\Fichier FTL - Copie.xls")
 
    appexcel.Sheets("FTL").Select
' lecture des enregistrements sélectionnés
    With rstMecanismes
        Do Until .EOF
            appexcel.Cells(i, 10) = ![Type de produit] & ":" & " " & ![Produit]
            appexcel.Cells(i, 11) = ![Criteria] & ":" & " " & ![Performances requises] & " " & ![Unit] & "  " & ![Comments]
            appexcel.Cells(i, 1) = ![Phase de vie FTL]
            appexcel.Cells(i, 2) = ![Fonction FTL]
            i = i + 1
            .MoveNext
        Loop
    End With
 
End If
 
 
End Sub