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

2 comentarios:

JK dijo...

Me dice que no se ha especificado ningún argumento para el parametro "Ruta" en Public Sub ExportarListViewXML(ByVal ListView As ListView, ByVal Ruta As String)...
¿qué debo escribir?

Adalberto Chavez dijo...

Alli tienes que poner la ruta donde quieres que se guarde el archivo

Publicar un comentario