Bonjour,

J'ai utilisé différents codes concernant l'automation de EXCEL pour créer un tableau et mettre les cellules en forme.

Le code marche très bien une première fois et dans ce cas, j'ai Activecell = <variable objet ou variable de bloc with non définie>

Mais lorsque je veux lancer une deuxième extraction, il plante et me sort une erreur '91'  <variable objet ou variable de bloc with non définie> alors que ActiveCell = nothing ....

Même en définissant la cellule ...

C'est 1 fois sur 2. Il suffit de réinitialiser le tout, fermer Excel sans enregistrer et relancer le tout et cela marche ... Malheureusement toujours 1 fois sur 2.

Pourriez vous m'aider car cela me prend vraiment le chou... (Avec mes excuses..)

Un grand merci par avance

Je vous joins un extrait du code si cela peut aider ...

Option Compare Database

Function TransfertExcelAutomationreqauto()
   
    Dim xlapp As Excel.Application
    Dim xlbook As Excel.Workbook
    Dim xlsheet As Excel.Worksheet
    Dim i As Long, J As Long, t As Variant
    Dim t0 As Long, t1 As Long
    Dim tbl As String
    t0 = Timer
    Dim rec As Recordset
    FichierXL = "C:accessSEPA_ACTIVITE_AUTO.XLS"
   
DoCmd.SetWarnings False

'Supprimer fichier si existe
If Dir(FichierXL, vbHidden) <> "" Then
    Kill FichierXL
End If
   
'Créer un objet Excel
Set xlapp = CreateObject("Excel.Application")
'Créer un nouveau classeur
Set xlbook = xlapp.Workbooks.Add
xlapp.Visible = True

'Traitement REQ AUT 1
'Chargement table de données
   
'suppression table REQ_AUT_1_TABLE si elle existe
tbl = "REQ_AUT_1_TABLE"
Delete_Table (tbl)
       
'Lancement nouvelle table
DoCmd.OpenQuery "REQ_AUT_1_CRETABLE", acViewNormal, acEdit
Set rec = CurrentDb.OpenRecordset("REQ_AUT_1_TABLE", dbOpenSnapshot)

'Ajouter une feuille de calcul et la nommer
Set xlsheet = xlbook.Worksheets.Add
xlsheet.Name = "Evol nbre dossiers"

'Ecrire le titre dans la cellule de ligne 1 et de colonne 1
xlsheet.Cells(1, 1) = rec.Fields(0)
   
'Gérer les entetes
For J = 1 To rec.Fields.Count - 1
  xlsheet.Cells(3, J) = "'" & rec.Fields(J).Name
Next J
 
'Recopier des données à partir de la ligne 4
i = 4
Do While Not rec.EOF
    For J = 1 To rec.Fields.Count - 1
        ' .Fields(Index).Type renvoie le type du champ
        '   si c'est un Texte (dbText) ou une date (spécifique) nous insérons "'" pour
        '   qu'il soit reconnu par Excel comme du Texte
        If rec.Fields(J).Type = dbText Then
            xlsheet.Cells(i, J) = "'" & rec.Fields(J)
        ElseIf rec.Fields(J).Type = dbDate Then
           xlsheet.Cells(i, J) = "'" & rec.Fields(J)
        Else
            xlsheet.Cells(i, J) = rec.Fields(J)
        End If
    xlsheet.Cells(i, J).Select
    Next J
    i = i + 1
    rec.MoveNext
Loop

'Traitement spécifique des cellules
xlsheet.Range("A3").Select
xlsheet.Range("a3").End(xlToRight).Offset(0, 1).FormulaR1C1 = "Total"
xlsheet.Range("a3").End(xlToRight).Offset(0, 0).Select
xlsheet.Range("a3").End(xlToRight).Offset(0, 0).Activate

xlsheet.Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
     With Selection
         .HorizontalAlignment = xlGeneral
         .VerticalAlignment = xlCenter
         .Borders(xlEdgeBottom).LineStyle = xlContinuous
         .Borders(xlEdgeLeft).LineStyle = xlContinuous
         .Borders(xlEdgeRight).LineStyle = xlContinuous
         .Borders(xlEdgeTo