[VBA ACCESS]Export Table sous Excel

**mathieu44800** · 14/02/2008, 11h22

Bonjour,

J'ai un petit soucis d'export d'une table dans un fichier Excel...

Je fais un SELECT sur une table ACCESS, que je veux transposer sur un fichier Excel.

Dans ce SELECT, j'ai un GROUP BY sur "NOM_FLUX", qui va me faire apparaitre un résultat de la forme :

"NOM_FLUX" | "" | "" | ""
"NOM_FLUX" | "" | "" | ""
"NOM_FLUX" | "" | "" | ""
"NOM_FLUX" | "" | "" | ""
"NOM_FLUX" | "" | "" | ""

J'exporte les données dans Excel mais je voudrais fusionner les cellules pour que "NOM_FLUX" n'apparaisse qu'une fois...

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
strCmd = "SELECT * FROM PARAM_CHEMIN WHERE NOM_FICHIER = 'Export_Matrice'"
                            If (ExecSQL(strCmd, rst)) Then
                                'strCheminS = rst.Fields("CHEMIN_FICHIER") & "Jour\Recu\Source\Entité\Recu_Source_Jour_Entité.xls"
                                'MsgBox strCheminS
                                strCheminD = rst.Fields("CHEMIN_FICHIER") & "Jour\Recu\Source\Entité\Recu_Source_Jour_Entité_" & Format(txtDate.Caption, "DDMMYYYY") & ".xls"
                                'If (objFSO.FileExists(strCheminS)) Then
                                    strCmd = "SELECT LIBELLE_PRESTATION, SUM(NB_RECU) AS NB_RECU1, DATE_RECU, LIBELLE_ENTITE, NOM_FLUX " & _
                                                "FROM FLUX, PRESTATION, ENTITE, RECU " & _
                                                "WHERE FLUX.ID_FLUX = PRESTATION.ID_FLUX AND PRESTATION.ID_PRESTATION = RECU.ID_PRESTATION AND RECU.ID_ENTITE = ENTITE.ID_ENTITE " & _
                                                "AND DATE_RECU = #" & CDate(Format(CDate(txtDate.Caption), "MM/DD/YYYY")) & "# AND LIBELLE_ENTITE = '" & txtSelect.Caption & "'" & _
                                                "GROUP BY NOM_FLUX, LIBELLE_ENTITE, LIBELLE_PRESTATION, DATE_RECU"
                                    If (ExecSQL(strCmd, rst)) Then
                                        If (Not rst.EOF) Then
                                            Set objWbk = objExcel.Workbooks.Add
                                            Set objSheet = objWbk.Sheets("Feuil1")
                                            'objSheet.Activate
                                            objSheet.Cells(2, 2) = "Reçu du " & Format(rst.Fields("DATE_RECU").Value, "DD/MM/YYYY") & " pour : " & rst.Fields("LIBELLE_ENTITE").Value
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Merge
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Font.Bold = True
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.Color = RGB(0, 0, 0)
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).HorizontalAlignment = xlHAlignCenter
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).VerticalAlignment = xlVAlignCenter
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.Weight = xlMedium
                                            objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.LineStyle = xlContinuous
                                            objSheet.Cells(6, 1) = "Source"
                                            objSheet.Cells(6, 1).Font.Bold = True
                                            objSheet.Cells(6, 1).HorizontalAlignment = xlHAlignCenter
                                            objSheet.Cells(6, 1).Borders.Color = RGB(0, 0, 0)
                                            objSheet.Cells(6, 1).Borders.Weight = xlMedium
                                            objSheet.Cells(6, 1).Borders.LineStyle = xlContinuous
                                            objSheet.Cells(6, 2) = "Libellé Typologie"
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Merge
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Font.Bold = True
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).HorizontalAlignment = xlHAlignCenter
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.Color = RGB(0, 0, 0)
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.Weight = xlMedium
                                            objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.LineStyle = xlContinuous
                                            objSheet.Cells(6, 6) = "Nombre"
                                            objSheet.Cells(6, 6).Font.Bold = True
                                            objSheet.Cells(6, 6).HorizontalAlignment = xlHAlignCenter
                                            objSheet.Cells(6, 6).Borders.Color = RGB(0, 0, 0)
                                            objSheet.Cells(6, 6).Borders.Weight = xlMedium
                                            objSheet.Cells(6, 6).Borders.LineStyle = xlContinuous
                                            i = 1
                                            j = 1
                                            While Not rst.EOF
                                                objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value
                                                objSheet.Cells(6 + i, 2) = rst.Fields("LIBELLE_PRESTATION").Value
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Merge
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).HorizontalAlignment = xlHAlignCenter
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Borders.Color = RGB(0, 0, 0)
                                                objSheet.Cells(6 + i, 6) = rst.Fields("NB_RECU1").Value
                                                objSheet.Cells(6 + i, 6).Borders.Color = RGB(0, 0, 0)
                                                rst.MoveNext
                                                If (Not rst.EOF) Then
                                                    If (objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value) Then
                                                        objSheet.Cells(6 + i, 1) = ""
                                                        j = j + 1
                                                    Else
                                                        k = i + j
                                                    End If
                                                Else
                                                    k = i + j
                                                End If
                                                i = i + 1                                            Wend
                                            MsgBox "Merge(" & j & ", " & k & ")"
                                            
                                            objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).Merge
                                            objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).HorizontalAlignment = xlHAlignCenter
                                            objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).Borders.Color = RGB(0, 0, 0)
                                            objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).VerticalAlignment = xlVAlignCenter
                                            
                                            
                                            Set objSheet = Nothing
                                            objWbk.Close True, strCheminD
                                            Set objWbk = Nothing
                                            
                                            MsgBox "Votre fichier à été sauvegardé à l'emplacement suivant : " & vbCrLf & strCheminD
                                        Else
                                            MsgBox "Aucune donnée à exporter ! "
                                        End If
                                    End If
                                End If

Please HELP !!!!

**sl.info** · 14/02/2008, 11h53

Il suffit de remplacer la ligne

Code :

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

objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).Merge

par

Code :

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

objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).MergeCells = True

**mathieu44800** · 14/02/2008, 14h57

Re,

Voici la solution pour fusionner les cellules telles que les valeurs du GROUP BY...

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
 
 
While Not rst.EOF
                                                objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value
                                                objSheet.Cells(6 + i, 2) = rst.Fields("LIBELLE_PRESTATION").Value
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Merge
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).HorizontalAlignment = xlHAlignCenter
                                                objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Borders.Color = RGB(0, 0, 0)
                                                objSheet.Cells(6 + i, 6) = rst.Fields("NB_RECU1").Value
                                                objSheet.Cells(6 + i, 6).Borders.Color = RGB(0, 0, 0)
                                                rst.MoveNext
                                                If (Not rst.EOF) Then
                                                    If (objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value) Then
                                                        objSheet.Cells(6 + i, 1) = ""
                                                    End If
                                                End If
                                                i = i + 1
                                            Wend
                                            i = i - 1 + 6
                                            While i > 6
                                                If (objSheet.Cells(i, 1) <> "") Then
                                                    intFin = i
                                                Else
                                                    j = j + 1
                                                End If
                                                MsgBox "Merge(" & intFin - j & ", " & intFin & ")"
                                                objSheet.Range(objSheet.Cells(intFin - j, 1), objSheet.Cells(intFin, 1)).Merge
                                                objSheet.Range(objSheet.Cells(7, 1), objSheet.Cells(i - 1 + 6, 1)).HorizontalAlignment = xlHAlignCenter
                                                objSheet.Range(objSheet.Cells(7, 1), objSheet.Cells(i - 1 + 6, 1)).Borders.Color = RGB(0, 0, 0)
                                                objSheet.Range(objSheet.Cells(7, 1), objSheet.Cells(i - 1 + 6, 1)).VerticalAlignment = xlVAlignCenter
                                                i = i - 1
                                            Wend

Merci de votre aide...

[VBA ACCESS]Export Table sous Excel

VBA Access

Vue hybride

Discussions similaires

Partager

Partager