Mensaje enviado por Alfonso Saiz <Alfonso.Saiz@caleidos.es>
Hola Daniel,
Felicidades por tu boda.
Te envío una rutina que tengo yo para grabar datos de una listview a una hoja de excel. Para un DBGrid debes seguir el mismo planteamiento. Debes recorrerte cada fila y grabar los datos.
Sub Setup_XL_WorkSheet()
On Error GoTo Errores
Dim Targetdir As String
Contador_Project_Planning = 1
Contador_Project_Selected = 1
Contador_Project_Files = 1
' Presentamos un mensaje en la barra de estado
BarraEstado.Panels.item(1).Text = "Creating excel sheets..."
MousePointer = vbHourglass
Targetdir = "\\POSEIDON\CaleidosB\" & Format(clientCode, "####0000")
& "\" & ArchivoExcel & ".xls"
Set appXL = CreateObject("Excel.Application") 'run it
appXL.Workbooks.Add
contador_Fila = 1
' Renombro las hojas de Excel y le pongo los encabezados para introducir los datos
appXL.Sheets("sheet1").Select
appXL.Sheets("sheet1").Name = "Hoja primera"
appXL.Cells(Contador_Project_Selected, 1).Value = "Titulo 1"
appXL.Cells(Contador_Project_Selected, 2).Value = "Titulo 2"
appXL.Cells(Contador_Project_Selected, 3).Value = "Titulo 3"
Contador_Project_Selected = Contador_Project_Selected + 1
' Renombro las hojas de Excel y le pongo los encabezados para introducir los datos
appXL.Sheets("sheet2").Select
appXL.Sheets("sheet2").Name = "Hoja segunda"
appXL.Cells(Contador_Project_Files, 1).Value = "Titulo 1"
appXL.Cells(Contador_Project_Files, 2).Value = "Titulo 2"
appXL.Cells(Contador_Project_Files, 3).Value = "Titulo 3"
appXL.Cells(Contador_Project_Files, 4).Value = "Titulo 4"
' Seleccionamos la hoja de Excel a escribir y añadimos los datos
appXL.Sheets("Hoja primera").Select
For Registro = 1 To ProjectTaskList.ListItems.Count
appXL.Cells(Contador_Project_Selected, 1).Value =
ProjectTaskList.ListItems(Registro).Text
appXL.Cells(Contador_Project_Selected, 2).Value =
ProjectTaskList.ListItems(Registro).SubItems(1)
appXL.Cells(Contador_Project_Selected, 3).Value =
ProjectTaskList.ListItems(Registro).SubItems(2)
Contador_Project_Selected = Contador_Project_Selected + 1
Next
' Seleccionamos la hoja de Excel a escribir y añadimos los datos
appXL.Sheets("Hoja segunda").Select
For Registro = 1 To ProjectPlanning.ListItems.Count
appXL.Cells(Contador_Project_Planning, 1).Value =
ProjectPlanning.ListItems(Registro).Text
appXL.Cells(Contador_Project_Planning, 2).Value =
ProjectPlanning.ListItems(Registro).SubItems(1)
appXL.Cells(Contador_Project_Planning, 3).Value =
ProjectPlanning.ListItems(Registro).SubItems(2)
appXL.Cells(Contador_Project_Planning, 4).Value =
ProjectPlanning.ListItems(Registro).SubItems(3)
Contador_Project_Planning = Contador_Project_Planning + 1
Next
' Guardamos la hoja y cerramos Excel
appXL.ActiveWorkbook.SaveAs Targetdir
appXL.ActiveWorkbook.Close (False)
appXL.Application.Quit
Set appXL = Nothing
' Restauramos los valores de la barra de estado
BarraEstado.Panels.item(1).Text = "Status"
MousePointer = vbDefault
Exit Sub
Errores:
Select Case Err.Number
Case 1004
MsgBox "The specified file:" & vbCr & Targetdir & vbCr & "could not be found. Please check it.", vbExclamation
appXL.Application.Quit
Set appXL = Nothing
' Restauramos los valores de la barra de estado
BarraEstado.Panels.item(1).Text = "Status"
MousePointer = vbDefault
Exit Sub
End Select
End Sub
No olvides marcar en el menú Project\References la librería de Microsoft Excel 8.0 Object Library .
Espero que te sirva.