Exportation Access vers Excel : Erreur 462
Bonjour à tous,
Voilà, je m'arrache les cheveux (encore une fois) sur une erreur que j'ai lorsque je fais une exportation de requête de Access vers une feuille Excel. Voici mon code :
Code:
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
108
109
110
111
112
113
114
115
116
117
| Function TransfertExcelAutomation()
Dim qd As QueryDef
Dim SQL As String
Dim val_export As Long
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim I As Long, J As Long
Dim t, l As Long
Dim Obj As OLEObject
Dim rec As Recordset
Dim exist As Recordset
Dim rec_next As Double
Dim nb_enre As Long
Dim RetVal As Variant
ExisteTable ("chgmt_cable") 'vérifie l'existance de la requête
SQL = "SELECT mes_champs FROM ma_requete "
Set qd = CurrentDb.CreateQueryDef("requete_tempo", SQL) 'Crée la requete temporaire
File_path = EnregistrerUnFichier(Me.hwnd, "Enregistrer fichier sous", "changement_liaison.xls", "C:\") ' permet d'enregistrer un nouveau fichier Excel et de mettre son chemin dans File_path
If File_path <> "" Then
DoCmd.OutputTo acOutputQuery, "requete_tempo", acSpreadsheetTypeExcel9, File_path, False 'L'ouvre sous excel
Set rec = CurrentDb.OpenRecordset("requete_tempo", dbOpenSnapshot)
'Initialisations
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(File_path)
'Ajouter une feuille de calcul
Set xlSheet = xlBook.Worksheets(1)
' les entetes
For J = 0 To rec.Fields.Count - 1
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(1, J + 1)
.Interior.ColorIndex = 8
.Interior.Pattern = xlSolid
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
Next J
'ERREUR ICI''''''''''''''''''''''''''''''''''''''''''''''''''''
xlBook.Activate
xlBook.Windows(1).SplitRow = 1
xlBook.Windows(1).FreezePanes = True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' recopie des données à partir de la ligne 3
I = 2
nb_enre = rec.RecordCount + 1
Do While Not (I = nb_enre)
If (rec_next <> Null Or rec(2) <> "Null") Then
rec.MoveNext
rec_next = rec(2).value
rec.MovePrevious
If (rec_next <> rec(2).value) Then
'For J = 0 To rec.Fields.Count - 1
xlSheet.Rows(I).Borders(xlEdgeBottom).Weight = xlThick
'Next J
End If
End If
xlSheet.Activate
xlSheet.Cells(I, 18).Select
t = ActiveCell.Top
l = ActiveCell.Left
If chk_budget.value = True Then
Set Obj = xlBook.ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=l + 30, Top:=t + 2, Width:=10, Height:=10) 'Créer une checkbox
Obj.name = "Check" & I
End If
I = I + 1
rec.MoveNext
Loop
' code de fermeture et libération des objets
'xlBook.Application.Visible = True
'xlBook.Save
xlApp.ActiveWorkbook.Save
xlApp.Application.Quit
RetVal = Shell("Taskkill /im Excel.exe /f", 0) 'Supprime toutes les tâches Excel
rec.Close
'Set rec = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
Set qd = Nothing
DoCmd.DeleteObject acQuery, "requete_tempo" 'La supprime
End Function |
Tout monde code fonctionne correctement lors de la première exécution, mais lorsque j'éxecute une seconde fois le même code directement après, j'ai cette erreur : "Le serveur distant n'existe pas ou n'est pas disponible" (erreur 462). Lors d'un deboggage pas à pas, j'ai remarqué que l'erreur venait lorsque j'execute un Freezepanes.... J'ai déjà essayé plein d'écriture différentes pour celui-ci, mais je ne comprend vraiment pas :(
Un deuxième petit "bug" intervient lors de la création des "checkbox" sous Excel (OLEObjects....). Ca fonctionne bien quand j'en crée une 100 aine, mais ma requête fais 3000 lignes, et ca plante à environ 1000, je ne comprend pas... (Erreur : "Error automation")
Voilà, j'espère avoir été assez explicite ! Merci d'avance !
Assyris
