Lentitud traspaso datos a un excel
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
¿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