Exporter resultat d'un sous formulaire dans excel

Private Sub cmdTestXcl_Click()

    Dim sqlChamp As QueryDef
    Dim test As QueryDef
    CurrentDb.CreateQueryDef "sqlChamp"
    CurrentDb.CreateQueryDef "test"
    Dim filt As String
    Dim ord As String
    Dim str As String
    Dim det As String
    Dim var As String
    Dim qry As QueryDef
    
    xclTool = Forms![frmMain]![sfmToolsList].Form.RecordSource
    Set qry = CurrentDb.QueryDefs(xclTool)
    str = qry.SQL
    
    CurrentDb.QueryDefs("sqlChamp").SQL = str
    filt = Forms![frmMain]![sfmToolsList].Form.Filter
    ord = Forms![frmMain]![sfmToolsList].Form.OrderBy
    det = "SELECT sqlChamp.ToolName, sqlChamp.ToolSupplier, sqlChamp.ToolSheet From sqlChamp Where " + filt + " Order By " + ord + ";"
    CurrentDb.Execute "Update sqlChamp Set ToolSheet = 'Ok' WHERE ToolSheet <> '' ;"
    CurrentDb.QueryDefs("test").SQL = det
    
    Dim ter As String
    ter = EnregistrerUnFichier(Me.hwnd, "Enregistrer sous", "Test.xls", "C:\Documents and Settings\" & login & "\")
    If Not IsNull(ter) And ter <> "" Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "test", ter, True
        
        Dim xlApp As Excel.Application
        Dim xlSheet As Excel.Worksheet
        Dim xlBook As Excel.Workbook
       
        ' Initialiser les variables
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = xlApp.Workbooks.Open(ter)
        Set xlSheet = xlBook.Worksheets("test")
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 10)).ColumnWidth = 38
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 10)).Font.Bold = True
        xlBook.SAve
        xlApp.Quit
        Set xlSheet = Nothing
        Set xlBook = Nothing
        Set xlApp = Nothing
    End If
    
    DoCmd.DeleteObject acQuery, "test"
    DoCmd.DeleteObject acQuery, "sqlChamp"
    
End Sub