Ce didacticiel couvrira les moyens d'importer des données d'Excel dans une table Access et les moyens d'exporter des objets Access (requêtes, rapports, tableaux ou formulaires) vers Excel.
Importer un fichier Excel dans Access
Pour importer un fichier Excel dans Access, utilisez le acImporter possibilité de Feuille de calcul DoCmd.Transfer :
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:\Temp\Book1.xlsx", True
Ou vous pouvez utiliser DoCmd.TransferText pour importer un fichier CSV :
DoCmd.TransferText acLinkDelim, , "Table1", "C:\Temp\Book1.xlsx", True
Importer Excel pour accéder à la fonction
Cette fonction permet d'importer un fichier Excel ou un fichier CSV dans une table d'accès :
Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean ' Exemple d'utilisation : appelez ImportFile ("Sélectionnez un fichier Excel", "Fichiers Excel", "*.xlsx", "C:\" , True ,True, "ExcelImportTest", True, True, false, True) En cas d'erreur GoTo err_handler If (Right(Filename, 3) = "xls") Ou ((Right(Filename, 4) = "xlsx")) Then DoCmd. TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames End If If (Right(Filename, 3) = "csv") Then DoCmd.TransferText acLinkDelim, , TableName, Filename, True End If Exit_Thing : « Nettoyer » Vérifiez si notre lien dans La table Excel existe déjà… et supprimez-la si c'est le cas If ObjectExists("Table", TableName) = True Then DropTable (TableName) Set colWorksheets = Nothing Exit Function err_handler: If (Err.Number = 3086 Ou Err.Number = 3274 Ou Err. Number = 3073) And errCount < 3 Then errCount = errCount + 1 ElseIf Err.Number = 3127 Then MsgBox "Les champs de tous les onglets sont les mêmes. Veuillez vous assurer que chaque feuille a les noms exacts des colonnes si vous souhaitez importer plusieurs", vbCritical, "MultiSheets non identiques" ImportFile = False GoTo Exit_Thing Else MsgBox Err.Number & " - " & Err.Description ImportFile = False GoTo Exit_Thing Resume End If End Function
Vous pouvez appeler la fonction comme ceci :
Private Sub ImportFile_Example() Appelez VBA_Access_ImportExport.ImportFile("C:\Temp\Book1.xlsx", True, "Imported_Table_1") End Sub
Accéder à l'exportation VBA vers un nouveau fichier Excel
Pour exporter un objet Access vers un nouveau fichier Excel, utilisez le DoCmd.SortieVers méthode ou la Méthode DoCmd.TransferSpreadsheet:
Exporter la requête vers Excel
Cette ligne de code VBA exportera une requête vers Excel à l'aide de DoCmd.OutputTo :
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:\temp\ExportedQuery.xls"
Ou vous pouvez utiliser la méthode DoCmd.TransferSpreadsheet à la place :
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:\temp\ExportedQuery.xls", True
Noter: Ce code exporte au format XLSX. Au lieu de cela, vous pouvez mettre à jour les arguments pour exporter vers un format de fichier CSV ou XLS à la place (ex. acFormatXLSX à acFormatXLS).
Exporter le rapport vers Excel
Cette ligne de code exportera un rapport vers Excel à l'aide de DoCmd.OutputTo :
DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:\temp\ExportedReport.xls"
Ou vous pouvez utiliser la méthode DoCmd.TransferSpreadsheet à la place :
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:\temp\ExportedReport.xls", True
Exporter le tableau vers Excel
Cette ligne de code exportera un tableau vers Excel à l'aide de DoCmd.OutputTo :
DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:\temp\ExportedTable.xls"
Ou vous pouvez utiliser la méthode DoCmd.TransferSpreadsheet à la place :
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:\temp\ExportedTable.xls", True
Exporter le formulaire vers Excel
Cette ligne de code exportera un formulaire vers Excel à l'aide de DoCmd.OutputTo :
DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:\temp\ExportedForm.xls"
Ou vous pouvez utiliser la méthode DoCmd.TransferSpreadsheet à la place :
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:\temp\ExportedForm.xls", True
Exporter vers les fonctions Excel
Ces commandes d'une ligne fonctionnent très bien pour exporter vers un nouveau fichier Excel. Cependant, ils ne pourront pas exporter dans un classeur existant. Dans la section ci-dessous, nous présentons des fonctions qui vous permettent d'ajouter votre exportation à un fichier Excel existant.
En dessous, nous avons inclus des fonctions supplémentaires pour exporter vers de nouveaux fichiers Excel, y compris la gestion des erreurs et plus encore.
Exporter vers un fichier Excel existant
Les exemples de code ci-dessus fonctionnent très bien pour exporter des objets Access vers un nouveau fichier Excel. Cependant, ils ne pourront pas exporter dans un classeur existant.
Pour exporter des objets Access vers un classeur Excel existant, nous avons créé la fonction suivante :
Fonction publique AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount As Integer Const xlToRight As Long = -4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges) Case "Form" Set rst = Forms(strObjectName).RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then MsgBox "Aucun enregistrement à exporter .", vbInformation, GetDBTitle Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject("Excel.Application") End If Err.Clear ApXL.Visible = False Définir xlWBk = ApXL.Workbooks.Open(strFil eName) Définir xlWSh = xlWBk.Sheets.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Select Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount). Name ApXL.ActiveCell.Offset(0, 1).Select intCount = intCount + 1 Loop d'abord.MoveFirst xlWSh.Range("A2").CopyFromRecordset d'abord avec ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight)).Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.Borders xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.Cells.Wrap = F .EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End With 'xlWB.Close True 'Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
Vous pouvez utiliser la fonction comme ceci :
Private Sub AppendToExcel_Example() Appelez VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Notez qu'il vous est demandé de définir :
- Que sortir ? Tableau, rapport, requête ou formulaire
- Nom de l'objet
- Nom de la feuille de sortie
- Chemin et nom du fichier de sortie.
Exporter la requête SQL vers Excel
Au lieu de cela, vous pouvez exporter une requête SQL vers Excel en utilisant une fonction similaire :
Fonction publique AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String) Dim strQueryName As String Dim ApXL As Excel.Application Dim xlWBk As Excel.Workbook Dim xlWSh As Excel.Worksheet Dim intCount As Integer Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlVAlignCenter = -4108 Const xlContinuous As Long = 1 Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset strQueryName = "tmpQueryToExportToExcel" If ObjectExists("Query", strQueryName) Then CurrentDb.DefsStrName.Delete End If Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql) Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset) If rst.RecordCount = 0 Then MsgBox "Aucun enregistrement à exporter.", vbInformation, GetDBTitle Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") Si Err.Number 0 Then Set ApXL = CreateObject("Excel.Application") End If Err.Clear ApXL.Visible = False Set xlWBk = ApXL.Workbooks.Open(strFileName) Set xlWSh = xlWBk.Feuille s.Add xlWSh.Name = Left(strSheetName, 31) xlWSh.Range("A1").Select Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset( 0, 1).Select intCount = intCount + 1 Loop d'abord.MoveFirst xlWSh.Range("A2").CopyFromRecordset d'abord avec ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight) ).Select .Selection.Interior.Pattern = xlSolid .Selection.Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone terFilFelection.Selection .EntireColumn.AutoFit .Cells.EntireRow.AutoFit .Range("B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveWSSheet.Cells.EntirehR ("A1").Select .Visible = True End With 'xlWB.Close True' Set xlWB = Nothing 'ApXL.Quit 'Set ApXL = Nothing End If End Function
Appelé comme ceci :
Private Sub AppendToExcelSQLStatemet_Example() Appelez VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:\Temp\Test.xlsx") End Sub
Où vous êtes invité à saisir :
- Requête SQL
- Nom de la feuille de sortie
- Chemin et nom du fichier de sortie.
Fonction pour exporter vers un nouveau fichier Excel
Ces fonctions vous permettent d'exporter des objets Access vers un nouveau classeur Excel. Vous pourriez les trouver plus utiles que les simples lignes simples en haut du document.
Fonction publique ExportToExcel(strObjectType As String, strObjectName As String, Optionnel strSheetName As String, Optionnel strFileName As String) Dim rst As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim intCount As Integer Const xlToRight As Long = - 4161 Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 Const xlContinuous As Long = 1 On Error GoTo ExportToExcel_Err DoCmd.Hourglass True Select Case strObjectType Case "Table", "Query" Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset , dbSeeChanges) Case "Form" Set rst = Forms(strObjectName).RecordsetClone Case "Report" Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges) End Select If rst.RecordCount = 0 Then MsgBox "No enregistrements à exporter.", vbInformation, GetDBTitle DoCmd.Hourglass False Else On Error Resume Next Set ApXL = GetObject(, "Excel.Application") If Err.Number 0 Then Set ApXL = CreateObject("Excel.Application") End If Se tromper. Effacer sur erreur GoTo ExportToExcel_Err Set xlWBk = ApXL.Workbooks.Add ApXL.Visible = False Set xlWSh = xlWBk.Worksheets("Sheet1") If Len(strSheetName) > 0 Then xlWSh.Name = Left(strSheetName, 31) End If xlWSh .Range("A1").Sélectionnez Do Until intCount = rst.fields.Count ApXL.ActiveCell = rst.fields(intCount).Name ApXL.ActiveCell.Offset(0, 1).Select intCount = intCount + 1 Loop rst. MoveFirst xlWSh.Range("A2").CopyFromRecordset d'abord avec ApXL .Range("A1").Select .Range(.Selection, .Selection.End(xlToRight)).Select .Selection.Interior.Pattern = xlSolid .Selection. Interior.PatternColorIndex = xlAutomatic .Selection.Interior.TintAndShade = -0.25 .Selection.Interior.PatternTintAndShade = 0 .Selection.Borders.LineStyle = xlNone .Selection.AutoFilter .Cells.EntireColumn.AutoFit.Fit .Cells B2").Select .ActiveWindow.FreezePanes = True .ActiveSheet.Cells.Select .ActiveSheet.Cells.WrapText = False .ActiveSheet.Cells.EntireColumn.AutoFit xlWSh.Range("A1").Select .Visible = True End Wi e réessayer : If FileExists(strFileName) Then Kill strFileName End If If strFileName "" Then xlWBk.SaveAs strFileName, FileFormat:=56 End If rst.Close Set rst = Nothing DoCmd.Hourglass False End If ExportToExcel_Exit: DoCmd.Hourglass Function False ExportToExcel_Err : DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number DoCmd.Hourglass False Resume ExportToExcel_Exit End Function
La fonction peut être appelée comme ceci :
Private Sub ExportToExcel_Example() Appelez VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet") End Sub
