Lentitud traspaso datos a un excel

Eduard
03 de Noviembre del 2004
He hecho un codigo que rellena el contenido de una hoja de excel con el de una tabla de access. La tabla tiene 3700 registros y tarda unos 70 segundos en rellenar toda la excel.ES DEMASIADO TIEMPO!!!
¿Podeis echarme una mano para que sea más rápido?

Gracias a todos por vuestra ayuda

'Set objExcel = New Excel.Application
Set objExcel = CreateObject("excel.application")
objExcel.Visible = False
'determina el numero de hojas que se mostrara en el Excel
objExcel.SheetsInNewWorkbook = 1
'Crea el Libro
objExcel.Workbooks.Add

With objExcel.ActiveSheet
.Range(.Cells(1, 1), .Cells(1, 4)).Borders.LineStyle = xlContinuous
.Cells(1, 1) = "Codigo"
.Cells(1, 2) = "Descripcion"
.Cells(1, 3) = "Unidades_presupuesto"
.Cells(1, 4) = "unidades_venta"
.Cells(1, 5) = "unidades_presupuesto_Rev"
.Cells(1, 6) = "fecha"
.Cells(1, 7) = "cliente"
.Cells(1, 8) = "Cliente_descripcion"
.Cells(1, 9) = "Tipo"
.Cells(1, 10) = "mes"
.Cells(1, 11) = "Año"
.Cells(1, 12) = "Gama"
.Cells(1, 13) = "Formato"
.Cells(1, 14) = "Precio"
End With
ProgressBar1.Value = 1
Dim variableregistros As Long
Dim valorbar As Long
variableregistros = MiTabla.RecordCount
ProgressBar1.Max = variableregistros
valorbar = 1
v = 2
H = 1
Do While Not MiTabla.EOF

DoEvents
objExcel.ActiveSheet.Cells(v, H) = MiTabla.Fields!Codigo
objExcel.ActiveSheet.Cells(v, H + 1) = MiTabla.Fields!descripcion
objExcel.ActiveSheet.Cells(v, H + 2) = MiTabla.Fields!unidades_presupuesto
objExcel.ActiveSheet.Cells(v, H + 3) = MiTabla.Fields!unidades_venta
objExcel.ActiveSheet.Cells(v, H + 4) = MiTabla.Fields!unidades_presupuesto_Rev
objExcel.ActiveSheet.Cells(v, H + 5) = MiTabla.Fields!fecha
objExcel.ActiveSheet.Cells(v, H + 6) = MiTabla.Fields!Cliente
objExcel.ActiveSheet.Cells(v, H + 7) = MiTabla.Fields!Cliente_descripcion
objExcel.ActiveSheet.Cells(v, H + 8) = MiTabla.Fields!Tipo
objExcel.ActiveSheet.Cells(v, H + 9) = MiTabla.Fields!mes
objExcel.ActiveSheet.Cells(v, H + 10) = MiTabla.Fields!año
objExcel.ActiveSheet.Cells(v, H + 11) = MiTabla.Fields!gama
objExcel.ActiveSheet.Cells(v, H + 12) = MiTabla.Fields!Formato
objExcel.ActiveSheet.Cells(v, H + 13) = MiTabla.Fields!precio
v = v + 1
ProgressBar1.Value = valorbar
valorbar = valorbar + 1
MiTabla.MoveNext
Loop


MiBase.Close