Discussion :

[maxtheb]

Bonjour,
J'ai une base de données Access.
Je souhaite transférer une table sous Excel.
J'utilise la commande TransferSpreadsheet.
Sauf que, dans ma table, certains champs textes contiennent un espace à la fin (que je dois conserver) et lorsque le fichier Excel est créé, ces espaces ont disparu ...

Est ce que quelqu'un aurait une idée pour contourner ce problème ? (à part retravailler le fichier après l'export)

Merci d'avance pour votre aide !

[marot_r]

Je copierai moi-même les données dans la cellule Excel en utilisant une boucle VBA.

Un truc du genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Ouvre le fichier Excel
Se positionne sur la feuille voulue
Se positonne dans la 1ère celule
 
tant qu'il y a des lignes dans la source
   pour chacun des champs dans la source
       copier la valeur du champ dans la cellule.
   fin pour
fin tant-que
 
fermer le Excel.

Fait un test juste avec une cellule pour voir si cela marche avant de te lancer plus avant.

A+

[paidge]

Bonjour,

Justement j'ai travaillé là-dessus y'a pas très longtemps. Donc voici mon code simplifié inspiré de la FAQ et des tutos trouvés ici-même ça peut t'être utile :

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Private Const ligneDepart As Integer = 3
 
Public Function genererExcel(monParametre As String) As String
 
    Dim XLApp As New Excel.Application
    Dim XLBook As Excel.Workbook
    Dim XLSheet As Excel.Worksheet
    Dim strSQL As String, strPath As String
    Dim rst As DAO.Recordset
    Dim i As Long, j As Long, nbColonnes As Long, 
 
    On Error GoTo Err_genererExcel
 
    ' ===== Initialisation des variables =====
    strPath = "C:\monDossier\"
    If Dir(strPath, vbDirectory) = "" Then
        MkDir (strPath)
    End If
 
	strPath = strPath & "monFichier.xlsx"
 
    Set XLBook = XLApp.Workbooks.Add
    Set XLSheet = XLBook.Worksheets(1)
 
    strSQL = "SELECT * " & _
			 "FROM maTable " & _
			 "WHERE monChamps = monCritere " & _
			 "AND monFiltre= """ & monParametre & """ " & _
			 "ORDER BY monTri;"
 
    Set rst = CurrentDb.OpenRecordset(strSQL)
    nbColonnes = rst.Fields.Count
    i = 0
 
    ' ===== Renommage de la feuille =====
    XLSheet.Name = "MaFeuille"
 
    ' ===== Formatage de l'en-tête =====
    With XLSheet
        .Cells.Locked = False
        For i = 1 To nbColonnes
            .Cells(ligneDepart, i) = rst.Fields(i - 1).Name
        Next i
 
        With .Range(.Cells(ligneDepart, 1), .Cells(ligneDepart, nbColonnes))
            .Interior.Color = RGB(204, 204, 153)
            .Font.Color = RGB(51, 102, 153)
            .Font.Bold = True
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlEdgeBottom).Weight = xlMedium
            .Borders(xlEdgeRight).Weight = xlMedium
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Locked = True
        End With
    End With
 
    ' ===== Remplissage de la feuille =====
    i = ligneDepart
    Do While Not rst.EOF
        i = i + 1
        For j = 1 To nbColonnes
            XLSheet.Cells(i, j) = rst(j - 1)
        Next j
        rst.MoveNext
    Loop
 
    ' ===== Formatage de la feuille =====
    With XLSheet
        With .Range(.Cells(ligneDepart, 1), .Cells(i, nbColonnes))
            .Columns.AutoFit
            .Borders.LineStyle = xlContinuous
            .Borders(xlEdgeLeft).Weight = xlMedium
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlEdgeBottom).Weight = xlMedium
            .Borders(xlEdgeRight).Weight = xlMedium
        End With
    End With
 
    ' ===== Sauvegarde du fichier =====
    XLBook.SaveAs strPath, _
                  FileFormat:=xlOpenXMLWorkbook, _
                  Password:="", _
                  WriteResPassword:="", _
                  ReadOnlyRecommended:=False, _
                  CreateBackup:=False
    genererExcel = strPath
 
Exit_genererExcel:
    XLBook.Saved = True
    XLApp.Quit
    Set rst = Nothing
    Set XLSheet = Nothing
    Set XLBook = Nothing
    Set XLApp = Nothing
    Exit Function
 
Err_genererExcel:
    Select Case Err.Number
        Case Else
            MsgBox "Erreur n°" & Err.Number & vbCrLf & -
				   "Description : " & Err.Description & vbCrLf & _
				   "Source : " & Err.Source, vbCritical, "Erreur"
    End Select
    Resume Exit_genererExcel
 
End Function