Resumen Exportar de un ListView a Excel

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.



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com