Je travaille sous access et j'ai écris un programme en vba permettant d'exporter une requete access dans un fichier excel.
Le problème, c'est qu'avec la mise en forme, le fichier est extremement long à s'ouvrir.
Je pense qu'il est possible d'améliorer pas mal de choses afin de faire en sorte que le fichier s'ouvre plus rapidement, mais je ne vois pas trop comment.
Donc si quelqu'un a une petite idée, ça m'aiderait bien.
Voici mon programme (je suis désolée si c'est un peu long et difficile à lire, mais je ne sais pas comment le joindre autrement) :
-----------------------------------------------------------------------------------------------------------------------
Function Export_to_Excel(paramvalue As String)
'fonction d'export de la requete paramétrée vers excel
'Declaration
Dim oXLApp As Object ' *** Excel.Application
Dim oWork As Workbook 'nom du classeur excel
Dim oFeuille As Worksheet 'nom de la feuille excel
Dim j As Long 'utilisé pour les colonnes
Dim I As Long 'utilisé pour les lignes
Dim qdf As QueryDef 'requete
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim nb As Long 'nombre de lignes (+1) du fichier
'Création de l'application excel
Set oXLApp = CreateObject("Excel.Application")
'création du classeur
Set oWork = oXLApp.Workbooks.Add
'création de la feuille
Set oFeuille = oWork.Worksheets(1)
'ouvre la requete dans un recordset en attribuant le client sélectionné dans la liste au paramètre de la requete
Set qdf = CurrentDb.CreateQueryDef("essais_un_client_res", "PARAMETERS [critereclient] string ; SELECT * FROM essais_un_client WHERE client_code = [critereclient];")
qdf.Parameters(0) = paramvalue 'valeur du paramètre critereclient
Set rst = qdf.OpenRecordset 'on ouvre le recordset
'Pour différencier les différentes parties du fichier, je mets différentes couleurs et différents
'titres à chaque partie
'Partie concernant la description de l'essai
For j = 1 To 19
oFeuille.Cells(1, 9).Interior.ColorIndex = 20 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 20 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 9) = "Essai" 'titre de la partie
oFeuille.Cells(1, 9).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
'Partie concernant le rapport de l'essai
For j = 20 To 28
oFeuille.Cells(1, 23).Interior.ColorIndex = 36 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 36 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 23) = "Rapport" 'titre de la partie
oFeuille.Cells(1, 23).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
'Partie concernant les actions de l'essai
For j = 29 To 34
oFeuille.Cells(1, 30).Interior.ColorIndex = 42 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 42 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 30) = "Actions" 'titre de la partie
oFeuille.Cells(1, 30).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
' le titre de la page dans la cellule de ligne 1 et de colonne 1
oFeuille.Cells(1, 2) = "Liste des essais du client : " & paramvalue
oFeuille.Cells(1, 2).Font.Bold = True 'texte de la cellule en gras
'Nom des en-tetes de chaque colonne
For j = 0 To rst.Fields.Count - 1 'rec.fields.count compte le nombre de colonnes du fichier
oFeuille.Cells(2, 1) = "Client"
oFeuille.Cells(2, 2) = "N° essai"
oFeuille.Cells(2, 3) = "Type"
oFeuille.Cells(2, 4) = "Site"
oFeuille.Cells(2, 5) = "Homologation"
oFeuille.Cells(2, 6) = "N° PV"
oFeuille.Cells(2, 7) = "type du produit"
oFeuille.Cells(2, 8) = "culture"
oFeuille.Cells(2, 9) = "Nom de l'agriculteur"
oFeuille.Cells(2, 10) = "Prénom de l'agriculteur"
oFeuille.Cells(2, 11) = "Code postal"
oFeuille.Cells(2, 12) = "lieu de l'essai"
oFeuille.Cells(2, 13) = "Début"
oFeuille.Cells(2, 14) = "Prévision ou non"
oFeuille.Cells(2, 15) = "Fin"
oFeuille.Cells(2, 16) = "Prévision ou non"
oFeuille.Cells(2, 17) = "PA"
oFeuille.Cells(2, 18) = "PE"
oFeuille.Cells(2, 19) = "CE"
oFeuille.Cells(2, 20) = "Format ARM"
oFeuille.Cells(2, 21) = "Exigence rapport à Pau"
oFeuille.Cells(2, 22) = "Arrivée rapport à Pau"
oFeuille.Cells(2, 23) = "COM format"
oFeuille.Cells(2, 24) = "COM langue"
oFeuille.Cells(2, 25) = "Type fichier à fournir"
oFeuille.Cells(2, 26) = "Draft demandé"
oFeuille.Cells(2, 27) = "Divers"
oFeuille.Cells(2, 28) = "Rapport final prêt pour facturation"
oFeuille.Cells(2, 29) = "Nature"
oFeuille.Cells(2, 30) = "Nom"
oFeuille.Cells(2, 31) = "Date"
oFeuille.Cells(2, 32) = "Prévision"
oFeuille.Cells(2, 33) = "Commentaire"
oFeuille.Cells(2, 34) = "Information envoyée au client le"
' mise en forme des cellules contenant les en-tetes
With oFeuille.Cells(2, j + 1) 'pour toutes les cellules de la lignes 2
.Borders(xlEdgeBottom).LineStyle = xlContinuous 'style de la bordure du bas en trait continu
.Borders(xlEdgeBottom).Weight = xlThin 'épaisseur de la bordure du bas en trait fin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic 'couleur de la bordure du bas automatique = noir
.Borders(xlEdgeTop).LineStyle = xlContinuous 'style de la bordure du haut en trait continu
.Borders(xlEdgeTop).Weight = xlThin 'épaisseur de la bordure du haut en trait fin
.HorizontalAlignment = xlCenter 'texte centré dans la cellule
End With
Next j
' copie le contenu du recordset dans la feuille excel à partir
'de la ligne 3 car les en-tetes sont dans la ligne 2
'oFeuille.Cells(3, 1).CopyFromRecordset rst
nb = 3
I = 3
Do While Not rst.EOF 'tant qu'on n'est pas à la fin du fichier
For j = 1 To rst.Fields.Count - 1 'pour chaque colonne du fichier
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText)
If rst.Fields(j).Type = dbText Then
'on insèrons "'" pour qu'il soit reconnu par Excel comme du Texte
oFeuille.Cells(I, j + 1) = "'" & rst.Fields(j)
Else
oFeuille.Cells(I, j + 1) = rst.Fields(j)
End If
'pour les types oui/non, les cases d'excel se remplissent avec VRAI (=oui) ou FAUX (=non)
'si c'est "FAUX"
If rst.Fields(j).Value = "FAUX" Then
'on remplace par la cellule vide
oFeuille.Cells(I, j + 1) = ""
Else
'si c'est "VRAI"
If rst.Fields(j).Value = "VRAI" Then
oFeuille.Cells(I, j + 1) = "x" 'on remplace par "x"
oFeuille.Cells(I, j + 1).HorizontalAlignment = xlCenter 'on centre le "x" dans la cellule
End If
End If
'on ajuste automatiquement la taille de chaque colonne en fonction du texte qu'elle contient
oFeuille.Columns("A:AY").EntireColumn.AutoFit
'Pour chaque date, si c'est une prévision, c'est à dire si la colonne suivante contient "x"
'on met la date en rouge
If oFeuille.Cells(I, 14) = "x" Then
oFeuille.Cells(I, 13).Font.ColorIndex = 3 'date en rouge
End If
If oFeuille.Cells(I, 16) = "x" Then
oFeuille.Cells(I, 15).Font.ColorIndex = 3 'date en rouge
End If
If oFeuille.Cells(I, 32) = "x" Then
oFeuille.Cells(I, 31).Font.ColorIndex = 3 'date en rouge
End If
'On cache les colonnes de prévision, c'est à dire les colonnes contenant "x"
oFeuille.Range("N:N").EntireColumn.Hidden = True
oFeuille.Range("P:P").EntireColumn.Hidden = True
oFeuille.Range("AF:AF").EntireColumn.Hidden = True
'On cache egalement la colonne contenant le nom du client
oFeuille.Range("A:A").EntireColumn.Hidden = True
Next j
nb = nb + 1 'on compte le nombre de lignes remplies
'le format date n'est pas conservé lors de l'exportation
'on met chaque colonne contenant des dates au format date
oFeuille.Cells(I, 13).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 15).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 21).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 22).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 28).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 31).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 34).NumberFormat = "dd/mm/yyyy"
'passage à la ligne suivante
I = I + 1
rst.MoveNext
Loop
'pour chaque ligne correspondant à un meme essai, on enleve toute
'la partie identique pour ne laisser que les actions (qui sont différentes), excepté sur la première ligne
'il faut aussi séparer les lignes correspondants à des essais différents
For I = nb To 1 Step -1 'on démarre à la derniere ligne
'si la deuxieme cellule (le numero d'essai) est égale a la deuxieme cellule de la ligne précédente
If oFeuille.Cells(I, 2) = oFeuille.Cells(I + 1, 2) Then
For j = 2 To 27 'pour chaque colonnes jusqu'à la 27
oFeuille.Cells(I + 1, j) = "" 'on vide les cellules
Next j
Else
For j = 1 To 34 'pour chaque cellule de la ligne
With oFeuille.Cells(I + 1, j).Borders(xlEdgeTop) 'on met une bordure supérieure pour différencier
'l'essai de celui de la ligne précédente
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
Next j
End If
Next I
For I = 2 To nb - 1 'pour chaque ligne du fichier
For j = 1 To 34 'pour chaque colonne
With oFeuille.Cells(I, j).Borders(xlEdgeLeft) 'création d'une bordure a gauche
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
With oFeuille.Cells(I, j).Borders(xlEdgeRight) 'création d'une bordure a droite
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
oFeuille.Cells(I, j).HorizontalAlignment = xlCenter 'centrer le texte de chaque cellule
Next j
Next I
oXLApp.Visible = True
rst.Close
qdf.Close
Set rst = Nothing
Set qdf = Nothing
CurrentDb.QueryDefs.Delete "essais_un_client_res"
Set oFeuille = Nothing
Set oWork = Nothing
Set oXLApp = Nothing
End Function
