exportez les donnees d'un Formulaire avec sous-formulaire dans un Format Excel

**james35** · 14/08/2006, 15h16

Salut a tous
J'ai un probleme et j'aimerais que vous puissiez bien m'aider.
J'ai cree un formulaire et avec Sous-formulaire qui marche sans Probleme.

Mais neamoins je suis confronte a un probleme.

J'aimerais que les resultats de mon formulaire et sous-Formulaire soient aussi transporte sur un Fomat Excel. A partir de la FAQ,j'ai pu programmer cela.

Avec le Formulaire cela marche a merveille.C'est au niveau du sous-formulaire que je rencontre encore certaines difficultes.

Par exemple dans le formulaire,j'ai le nom de la firme Test et test a beaucoup dans le sous-formulaire de HT-nummer,Art, Kostenstelle et Nettobetrag.Mais j'appuie la touche,n'apparait qu'un HT-nummer, un Art,un Kostenstelle,un Nettobetag.

Stp Comment devrais-je faire pour que Puisse apparaitre tous les Ht-nummer,Art,Kostenstelle,Nettobetrag du sous-formulaire quand il s'agit de la Firme Test par exemple.
Voici mon Kode:

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
41
Private Sub Befehl31_Click()
On Error Resume Next
 
    Dim appexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
 
    Set appexcel = CreateObject("Excel.Application")
    appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("C:\TEMP\est\Satre.xls")
 
     appexcel.Sheets("Tabelle1").Select
 
     appexcel.Cells(3, 1) = Me.Fa_Nr
     appexcel.Cells(3, 2) = Me.Firmenname
     appexcel.Cells(3, 3) = Me.Rue
     appexcel.Cells(3, 4) = Me.PostLeitzahl
     appexcel.Cells(3, 5) = Me.Lieu
     appexcel.Cells(3, 6) = Me.Firma_Auswertung_sousformulaire.Form.ID
     appexcel.Cells(3, 7) = Me.Firma_Auswertung_sousformulaire.Form.Kostenstelle
     appexcel.Cells(3, 8) = Me.Firma_Auswertung_sousformulaire.Form.Art
     appexcel.Cells(3, 9) = Me.Firma_Auswertung_sousformulaire.Form.Nettobetrag
     'appexcel.Cells(5, 7) = rst![Nomduchamps]
     appexcel.Cells(4, 6) = Me.Firma_Auswertung_sousformulaire.Form.ID
     appexcel.Cells(4, 7) = Me.Firma_Auswertung_sousformulaire.Form.Kostenstelle
     appexcel.Cells(4, 8) = Me.Firma_Auswertung_sousformulaire.Form.Art
     appexcel.Cells(4, 9) = Me.Firma_Auswertung_sousformulaire.Form.Nettobetrag
 
     appexcel.Cells(5, 6) = Me.Firma_Auswertung_sousformulaire.Form.ID
     appexcel.Cells(5, 7) = Me.Firma_Auswertung_sousformulaire.Form.Kostenstelle
     appexcel.Cells(5, 8) = Me.Firma_Auswertung_sousformulaire.Form.Art
     appexcel.Cells(5, 9) = Me.Firma_Auswertung_sousformulaire.Form.Nettobetrag
 
 
Exit_Befehl31_Click:
    Exit Sub
 
Err_Befehl31_Click:
    MsgBox Err.Description
    Resume Exit_Befehl31_Click
 
End Sub

Merci d'avance

**Meduse** · 14/08/2006, 16h50

Il y a un truc qui ne va pas dans ton code : tu oublies de passer à l'enregistrement suivant avant de remplir la ligne suivante dans Excel.
Il y a peut-être plus efficace, mais voici ce que je te suggère :

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
41
42
43
44
45
Private Sub Befehl31_Click()
On Error Resume Next

    Dim appexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
    Dim i As Long
    Dim RS As Recordset
    
    Set appexcel = CreateObject("Excel.Application")
    appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("C:\TEMP\est\Satre.xls")

     appexcel.Sheets("Tabelle1").Select
     
     appexcel.Cells(3, 1) = Me.Fa_Nr
     appexcel.Cells(3, 2) = Me.Firmenname
     appexcel.Cells(3, 3) = Me.Rue
     appexcel.Cells(3, 4) = Me.PostLeitzahl
     appexcel.Cells(3, 5) = Me.Lieu
     
     Set RS = Me.Firma_Auswertung_sousformulaire.Form.RecordsetClone
     
     If RS.EOF Then
        'S'il n'y a aucun enregistrement, tu veux peut-être faire qqch de spécial ici...
     Else
        RS.MoveFirst
        Do Until RS.EOF
           appexcel.Cells(3 + i, 6) = RS!ID
           appexcel.Cells(3 + i, 7) = RS!Kostenstelle
           appexcel.Cells(3 + i, 8) = RS!Art
           appexcel.Cells(3 + i, 9) = RS!Nettobetrag
           i = i + 1
           RS.MoveNext
        Loop
     End If
    
Exit_Befehl31_Click:
    Set RS = Nothing
    Exit Sub

Err_Befehl31_Click:
    MsgBox err.Description
    Resume Exit_Befehl31_Click
    
End Sub

**james35** · 14/08/2006, 17h02

Grand merci, cela marche coe je le pensais.

Mais j'ai un probleme avec Nettobetrag( elle n'affiche pas en Euro et le point virgule)
Stp comment devrais-je proceder

Merci d'avance

**james35** · 14/08/2006, 17h11

Stp le probleme n'est pas completement resolu.Le Sous-formulaire ne change plus quand je choisis dans le Formulaire une autre Firme par exemple exploitation.
Les donnees du sous-Formulaires restent les memes.

**Meduse** · 14/08/2006, 17h39

Envoyé par james35

Mais j'ai un probleme avec Nettobetrag( elle n'affiche pas en Euro et le point virgule)
Stp comment devrais-je proceder

C'est normal, l'export vers Excel copie les valeurs mais pas leur format.

Fais un essai sous Excel pour mettre tes champs au bon format (avec le menu Format/Cells/Number). Quand tu as trouvé, refais-le avec l'enregistreur de macros. Dans le code VBA sous Excel, tu devrais te retrouver avec qqch du genre :

Code :

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

1
2
3
4
5
6
7
8
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 14/08/2006 by
'
    Range("I7").Select
    Selection.NumberFormat = "#,##0.00 [$€-40C]"
End Sub

Tu peux ensuite l'utiliser sous Access en l'adaptant comme ça :

Code :

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

1
2
appexcel.Cells(3 + i, 9) = RS!Nettobetrag
appexcel.Cells(3 + i, 9).NumberFormat = "#,##0.00 [$€-40C]"

Si tu as encore des problèmes, par exemple avec la virgule, essaie de modifier les Paramètres régionaux dans le Panneau de configuration.

Envoyé par james35

Stp le probleme n'est pas completement resolu.Le Sous-formulaire ne change plus quand je choisis dans le Formulaire une autre Firme par exemple exploitation.
Les donnees du sous-Formulaires restent les memes.

Euh...ça, ça n'a rien à voir avec ce qu'on vient de faire.

**Muhad'hib** · 14/08/2006, 17h56

Salut,

Juste une petite chose : quand tu copie des données d'un recordset vers Excel tu peux utiliser

Code :

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

 ...cells(3,6).CopyFromRecordset Rs

Ca évite pas mal de boucle.

A+

**james35** · 14/08/2006, 18h00

Stp, pourriez vous etre un peu plus clair par rapport a ce que vous veniez de dire?
Et plus par rapport a ce Kode

**james35** · 15/08/2006, 10h17

Bonjour a tous
Stp je suis encore bloque au niveau du sous-formulaire.Car les donnees ne changent par a partir du formulaire dans Excel.
C-a-d quand je cherche la Firme Test avec tous les donnees du sous-formulaires a savoir le ID,Kostenstelle,Auftragsart,Nettobetrag, cela apparait sans probleme.
Et quand je change le nom de la firme par exemple Access,les donnees du sous-formulaire n'apparaissent pas dans Excel.Dans Excel ne restent que les donnees du sous-Formulaire-precedent.
Stp dites-moi comment je devrais cela a tel enseigne que cela puisse avoir une mobilite comme dans le formulaire.
Voici le code:

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
On Error Resume Next
 
    Dim appexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
    Dim i As Long
    Dim RS As Recordset
 
    Set appexcel = CreateObject("Excel.Application")
    appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("C:\TEMP\est\FIRMASAUSWERTUNG.xls")
 
     appexcel.Sheets("Tabelle1").Select
 
     appexcel.Cells(3, 1) = Me.Firmenname
 
     Set RS = Me.Firma_Auswertung_sousformulaire.Form.RecordsetClone
    If RS.EOF Then
        'S'il n'y a aucun enregistrement, tu veux peut-être faire qqch de spécial ici...
       ' mgsbox "Merci"
     Else
        RS.MoveFirst
        Do Until RS.EOF
           'appexcel.Cells(3, 6).CopyFromRecordset RS
           appexcel.Cells(3 + i, 2) = RS!ID
           appexcel.Cells(3 + i, 3) = RS!Kostenstelle
           appexcel.Cells(3 + i, 4) = RS!Art
           appexcel.Cells(3 + i, 5) = RS!Nettobetrag
           appexcel.Cells(3 + i, 5).NumberFormat = "#,##0.00 [$€-40C]"
           i = i + 1
           RS.MoveNext
        Loop
     End If
     Set RS = Nothing

Merci d'avance

**Muhad'hib** · 16/08/2006, 08h33

Salut,

Envoyé par james35

Stp, pourriez vous etre un peu plus clair par rapport a ce que vous veniez de dire?
Et plus par rapport a ce Kode

Dans ton code remplace :

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
 
If RS.EOF Then
        'S'il n'y a aucun enregistrement, tu veux peut-être faire qqch de spécial ici...
       ' mgsbox "Merci"
     Else
        RS.MoveFirst
        Do Until RS.EOF
           'appexcel.Cells(3, 6).CopyFromRecordset RS
           appexcel.Cells(3 + i, 2) = RS!ID
           appexcel.Cells(3 + i, 3) = RS!Kostenstelle
           appexcel.Cells(3 + i, 4) = RS!Art
           appexcel.Cells(3 + i, 5) = RS!Nettobetrag
           appexcel.Cells(3 + i, 5).NumberFormat = "#,##0.00 [$€-40C]"
           i = i + 1
           RS.MoveNext
        Loop
     End If

Par :

Code :

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

1
2
3
4
5
6
7
8
9
 
If RS.EOF Then
        'S'il n'y a aucun enregistrement, tu veux peut-être faire qqch de spécial ici...
       ' mgsbox "Merci"
     Else
         appexcel.Cells(3 , 2).CopyFromRecorset RS
         appexcel.Columns(5).NumberFormat = "#,##0.00 [$€-40C]"
 
     End If

A+