Eduard
02 de Noviembre del 2004

Tengo el codigo que os adjunto para traspasar los datos de una tabla a una hoja de calculo excel. El siguiente codigo, me crea un libro nuevo, pero a mi me gustaría colocarlo en una hoja llamada "tabla" dentro de una excel existente llamada analisis. Tambien me va superlento, hay alguna manera de acelerarlo? tengo 3500 registros.

Podeis echarme una mano? muchas gracias por anticipado

Dim H As Long 'Horizontal
Dim v As Long 'Vertical
Dim MiBase As Database
Dim MiTabla As Recordset


'Dim objExcel As Excel.Application
Dim objExcel As Object

Set MiBase = OpenDatabase("I:montbd1.mdb", False, False, ";PWD=31122004")
Set MiTabla = MiBase.OpenRecordset("SELECT * FROM Presupuesto_Vs_Venta_Real", dbOpenDynaset)

If MiTabla.RecordCount = 0 Then
MsgBox "La base de datos esta vacia"
Exit Sub
End If

'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

Set objExcel = Nothing
Exit Sub