lunes, 12 de diciembre de 2011

EXPORTAR LISTVIEW A EXCEL O LIBRE OFFICE O OPEN OFFICE

Modulo para extortar un Listview a Excel o Libre Office o Open Office en visual basic 2010.
Primero hay que crear un modulo con con el nombre ExportarXML.
Luego pegamos el código siguiente en el modulo.

Module ExportarXML
'Exportar a Excel
    'Autor: Adalberto Chavez

    Public Sub ExportarListViewXML(ByVal ListView As ListView, ByVal Ruta As String)
        Dim xmlFile As New System.Text.StringBuilder
        Dim CurrLine As String = String.Empty
        CurrLine = xmlEncabezado()
        CurrLine &= "<ss:Row>" & vbNewLine

        For columnIndex As Integer = 0 To ListView.Columns.Count - 1
            CurrLine &= "<ss:Cell  ss:StyleID='s27><Data ss:Type='String>" & ListView.Columns(columnIndex).Text & "</Data></ss:Cell>" & vbNewLine
        Next
        CurrLine &= "</ss:Row>" & vbNewLine
        xmlFile.AppendLine(CurrLine)
        Dim Tipo As String

        CurrLine = String.Empty
        For Each item As ListViewItem In ListView.Items
            CurrLine &= "<ss:Row>" & vbNewLine
            For Each subItem As ListViewItem.ListViewSubItem In item.SubItems
                If (IsNumeric(subItem.Text) And InStr(subItem.Text, ".")) Then
                    Tipo = "Number"
                Else
                    Tipo = "String"
                End If
                CurrLine &= "<ss:Cell><Data ss:Type='" & Tipo & ">" & subItem.Text & "</Data></ss:Cell>" & vbNewLine
            Next
            CurrLine &= "</ss:Row>" & vbNewLine
            xmlFile.AppendLine(CurrLine.Substring(0, CurrLine.Length - 1))
            CurrLine = String.Empty
        Next
        CurrLine = xmlFinal()
        xmlFile.AppendLine(CurrLine)
        Dim Sys As New System.IO.StreamWriter(Ruta)
        Sys.WriteLine(xmlFile.ToString)
        Sys.Flush()
        Sys.Dispose()


        If Comprobar("Excel.Application") Then
            'Abrimos con excel
            Process.Start("Excel.exe", Ruta)
        Else
            'Si no esta excel instalado abrimos con Libre Office
            Process.Start("scalc.exe", Ruta)
        End If
    End Sub


    'Formateamos el XML para Excel y Libre Office
    Private Function xmlEncabezado() As String

        xmlEncabezado = ""
        xmlEncabezado = xmlEncabezado & "<?xml version='1.0?>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<?mso-application progid='Excel.Sheet?>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Workbook" & vbNewLine
        xmlEncabezado = xmlEncabezado & "xmlns:x='urn:schemas-microsoft-com:office:excel" & vbNewLine
        xmlEncabezado = xmlEncabezado & "xmlns='urn:schemas-microsoft-com:office:spreadsheet" & vbNewLine
        xmlEncabezado = xmlEncabezado & "xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Styles>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Style ss:ID='Default ss:Name='Normal>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Alignment ss:Vertical='Bottom/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Borders/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Font/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Interior/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<NumberFormat/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Protection/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Style>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Style ss:ID='s27>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Font x:Family='Swiss ss:Color='#0000FF ss:Bold='1/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Style>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Style ss:ID='s21>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<NumberFormat ss:Format='yyyy\-mm\-dd/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Style>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Style ss:ID='s22>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<NumberFormat ss:Format='yyyy\-mm\-dd\ hh:mm:ss/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Style>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Style ss:ID='s23>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<NumberFormat ss:Format='hh:mm:ss/>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Style>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "</Styles>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<Worksheet ss:Name='Hoja 1>" & vbNewLine
        xmlEncabezado = xmlEncabezado & "<ss:Table>" & vbNewLine

    End Function


    'Finalizamos el xml
    Private Function xmlFinal() As String
        xmlFinal = ""
        'Finalizamos la Tabla
        xmlFinal = xmlFinal & "</ss:Table>" & vbNewLine
        'Finalizamos la Hoja
        xmlFinal = xmlFinal & "</Worksheet>" & vbNewLine
        ''Finalizamos el Libro
        xmlFinal = xmlFinal & "</Workbook>" & vbNewLine
    End Function

    Private Function Comprobar(Clase_Application As String) As Boolean

        Dim Objeto As Object

        ' Deshabilitar errores temporalmente  
        On Error Resume Next

        ' -- Crear una referencia al objeto  
        Objeto = CreateObject(Clase_Application)

        ' -- No dío error  
        If Err.Number <> 0 Then
            Comprobar = False
        Else
            ' .. error  
            Comprobar = True
            ' -- Eliminar  referencia  
            Objeto = Nothing
        End If

        ' -- Limpiar error  
        On Error GoTo 0

    End Function

End Module

0 comentarios:

Publicar un comentario