Sección de códigos , trucos y ejemplos para visual basic

301 - Exportar Excel a Html

Módulo para exportar una hoja de Microsoft Excel a un archivo HTML

El siguiente módulo permite exportar un rango de datos de una hoja Excel a un archivo Html.

Para usar el módulo hay que indicar en las propiedades los siguientes valores:

AutoAjustar_Columnas = valor Boolean para indicar si se hace un AutoSize de los encabezados, por defecto es True
Borde_Size_Tabla : Grosor del borde de la tabla, si no se especifica se utiliza un borde de 1
Path_HTML : Ruta donde se creará el archivo Html
Path_Excel : Ruta del libro
Rango : Rango de los datos, por ejemplo Rango = "A1:C4"
Hoja_Indice : la Hoja que se va a exportar, si no se indica se utiliza la primer Hoja , es decir la que Hoja 1
Titulo_Html : Titulo de encabezado

Luego para exportar .. ejecutar la función " Exportar "

Nota: El módulo NO exporta todo el formato de la fuente, por ejemplo no exporta el color , el color de la celda, el nombre de la fuente

Controles y referencias

Agregar la referencia a Microsoft Excel Object Library al proyecto
Añadir un módulo de clase ( dejarlo con el nombre por defecto Class1 )
Añadir un Command1 al formulario

Primero se lista el código del formulario y luego el que se debe añadir al módulo de clase

Cíodigo fuente en Form1

' Variable para el módulo
Dim oExportar As Class1


Private Sub Command1_Click()

    With oExportar
        
        ' Propiedades
        .AutoAjustar_Columnas = True
        .Borde_Size_Tabla = 1
        .Espaciado_Celda = 2
        .Margen_Celda = 2
        .Path_HTML = App.Path & "\a.html" 'Path donde crear el HTml
        .Path_Excel = "c:\Libro1.xls" 'Path del libro
        .Rango = "A1:B10" 'Rango de los datos a exportar
        .Hoja_Indice = 1 'Lahoja
        .Titulo_Html = " Exportar Excel a HTML " 'Titulo
        
        ' Exporta
        If .Exportar Then
            MsgBox " Hoja Exportada ", vbInformation
        End If
    
    End With
End Sub

Private Sub Form_Load()

    Set oExportar = New Class1
    Command1.Caption = " Exportar "
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not oExportar Is Nothing Then
        Set oExportar = Nothing
    End If
End Sub

Código en el módulo de clase

Option Explicit

' Propiedades
Public Path_HTML As String
Public Path_Excel As String
Public Rango As String
Public Titulo_Html As String
Public AutoAjustar_Columnas As Boolean
Public Margen_Celda As Integer
Public Espaciado_Celda As Integer
Public Borde_Size_Tabla As Variant
Public Hoja_Indice As Integer

' función que exporta
Function Exportar() As Boolean

On Error GoTo ErrFunction

Dim A As Integer
Dim Fila As Long
Dim Columna As Integer
Dim Fa As Long
Dim f As Integer
Dim CLinea As String
Dim tLine As String
Dim Ancho_Columna As Long
Dim BoldCell As Boolean
Dim Italic As Boolean
Dim Alig As Integer

' esta variable almacena el código html
Dim Codigo_Html As String

' Variables para la aplicación, la hoja y el rango del Excel
Dim OExcel As Object
Dim Hoja As Object
Dim o_Rango As Object

' Comprueba si se especificó el rango a exportar
If Rango = vbNullString Then
MsgBox "No se ha especificado el Rango para exportar", vbCritical
Exit Function
End If
'Comprueba si se indicó el path del HTML
If Path_HTML = vbNullString Then
MsgBox "No se ha especifado el path del archivo HTML", vbCritical
Exit Function
End If
'Comprueba si se indicó el path del Excel
If Path_Excel = vbNullString Then
MsgBox "No se ha especifado el path del archivo Excel", vbCritical
Exit Function
End If

' Si no se especificó la hoja, se utiliza la Hoja 1
If Hoja_Indice = 0 Then
Hoja_Indice = 1
End If

Screen.MousePointer = vbHourglass

' Crea un nuevo objeto Excel
Set OExcel = CreateObject("Excel.Application")

' Abre el libro
OExcel.Workbooks.Open FileName:=Path_Excel

' Referencia a la hoja que se va a Exportar
Set Hoja = OExcel.ActiveWorkbook.Sheets(Hoja_Indice)
' Referencia al rango de datos
Set o_Rango = Hoja.Range(Rango)

f = FreeFile
'Abre y crea el archivo Html
Open Path_HTML For Output As #f

On Error GoTo 0

Fa = 0
For A = 1 To o_Rango.Areas.Count
Fa = Fa + o_Rango.Areas(A).Rows.Count
Next A

' apertura del código HTML
Codigo_Html = "<html><head></head><body>" & "<h1>" & Titulo_Html & "</h1><Hr>"

' Crea el código de la tabla
If Borde_Size_Tabla = "" Or Borde_Size_Tabla = 0 Then
Codigo_Html = Codigo_Html & "<table border=""" & _
Borde_Size_Tabla & """ cellpadding=""" & Margen_Celda & _
""" cellspacing=""" & Espaciado_Celda & """>"
Else
Codigo_Html = Codigo_Html & "<table border=""" & _
Borde_Size_Tabla & """ cellpadding=""" & Margen_Celda & _
""" cellspacing=""" & Espaciado_Celda & _
""" width=""" & Borde_Size_Tabla & """>"
End If

For A = 1 To o_Rango.Areas.Count
'REcorre las filas
For Fila = 1 To o_Rango.Areas(A).Rows.Count
'Nueva celda
Codigo_Html = Codigo_Html & " <tr>"
'Recorre las columnas
For Columna = 1 To o_Rango.Areas(A).Columns.Count
CLinea = " "
Alig = 0
tLine = ""

On Error Resume Next

With o_Rango.Areas(A).Cells(Fila, Columna)
tLine = Trim(.Text)
BoldCell = .Font.Bold
Italic = .Font.Italic
Alig = .HorizontalAlignment
End With

On Error GoTo 0

If (tLine = "" Or tLine = " ") Then
tLine = " "
End If

If tLine <> "" Then
CLinea = CLinea & "<td"
' AutoSize de las columnas
If AutoAjustar_Columnas Then
Ancho_Columna = CLng(Hoja.Cells(1, Columna + 1).Left - _
Hoja.Cells(1, Columna).Left)
CLinea = CLinea & " width=""" & Ancho_Columna & """" & """>"
End If
'Alineamiento para los números
If Alig = xlHAlignGeneral Then
Select Case Asc(tLine)
Case 45, 48 To 57
Alig = xlHAlignRight
End Select
End If
'Alinear al centro
If Alig = xlHAlignCenter Then
CLinea = CLinea & " align=""center"""
End If
'Alinear a la derecha
If Alig = xlHAlignRight Then
CLinea = CLinea & " align=""right"""
CLinea = CLinea & ">"
End If
' Fuente Negrita
If BoldCell Then CLinea = CLinea & "<b>"
' Fuente Cursiva
If Italic Then CLinea = CLinea & "<i>"
CLinea = CLinea & tLine
'Cierra
If Italic Then CLinea = CLinea & "</i>"
If BoldCell Then CLinea = CLinea & "</b>"
CLinea = CLinea & "</td>"
'Agrega el código Html
Codigo_Html = Codigo_Html & CLinea
End If
Next Columna
'Cierra
Codigo_Html = Codigo_Html & " </tr>"

Next Fila
Next A
'cierra el código final
Codigo_Html = Codigo_Html & "</table></body></html>"

' Escribe el código HTml
Print #f, Codigo_Html

'Cierra el archivo
Close #f

'Cierra el Excel y descarga las referencias
OExcel.Quit

Set o_Rango = Nothing
Set Hoja = Nothing
Set OExcel = Nothing
Exportar = True
Screen.MousePointer = vbNormal
Exit Function

' Error
ErrFunction:
MsgBox Err.Description, vbCritical
On Error Resume Next

Close
OExcel.Quit
Set o_Rango = Nothing
Set Hoja = Nothing
Set OExcel = Nothing
Exportar = False
Screen.MousePointer = vbNormal
End Function

Private Sub Class_Initialize()
'Valores por defecto al iniciar
AutoAjustar_Columnas = True
Margen_Celda = 2
Espaciado_Celda = 2
Borde_Size_Tabla = 1
End Sub

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb