[Src][Cls] ManipulacionSimple Excel || Cls_ExcelAplication [Release Memory]

Bueno solo traigo este modulo de clase que sirve para que no se quede en memoria la aplicación Excel cuando la creamos con CreateObject(), por ejemplo, hace poco en este Post

http://foro.elhacker.net/programacion_visual_basic/como_exportar_mshflexgrid1_a_excel_expertos_en_vb60-t297037.0.html

Daba la cuestión que siempre para debugear (para ayudarle a Hunter18) se me quedaba la aplicación Abierta y la memoria bien gracias!¡.

Las funciones qué tiene integradas son dos:

Libro()
Hoja()

En el código fuente ya esta con sus descripciones de uso!¡, todo lo demás esta en cuestión vba (abran excel y hay mas o menos vean las propiedades qué podrán usar en vb6 con el objecto qué provenga del createObject("Excel.Application")).

Cls_ExcelAplication.cls

Código

'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   //                  Cls_ExcelAplication.cls                //
'   //                                                         //
'   /////////////////////////////////////////////////////////////
'
Rem Opciones.
Option Explicit
Rem End Opciones.
 
Rem Eventos.
Event Errores(ByRef Err As ErrObject)
Rem End Eventos.
 
Rem Declaraciones.
Private Obj_Excel               As Object
Rem End Declaraciones.
 
 
 
 
 
Rem Propiedades.
 
'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene la instancia de la aplicacion!¡..
'   //      </Objetivo>
'   //      <Return Tipo=Object Parcial={Excel.Application}>
'   //          Regresa el Objeto {Excel.Application}.
'   //      </Return>
'   //  </Metodo>
Public Property Get Excel() As Object
    Set Excel = Obj_Excel
End Property
 
'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene un libro segun los criterios, 1 HOJA!¡..
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si no existe el libro se crea uno nuevo!¡, solo por busqueda {Index&}.
'   //          *   Si no se ingresa ningun parametro Opcional se crea un nuevo libro y es devuelto!¡.
'   //      </Evaluaciones>
'   //      <Parametros>
'   //          <Opcional Nombre=Index& Datotipo=Long Predeterminado=-1>
'   //              indice del libro a buscar!¡.
'   //          </Opcional>
'   //          <Opcional Nombre=Hoja Datotipo=Object Predeterminado=Nothing>
'   //              Ignora el parametro {Index&} y procede a buscar en TODOS los libros abiertos la hoja deseada.
'   //          </Opcional>
'   //      </Parametros>
'   //      <Return Tipo=Object Parcial=Workbook>
'   //          Regresa el libro {Workbook} deseado!¡.
'   //      </Return>
'   //  </Metodo>
Public Property Get Libro(Optional ByRef Index& = -1, Optional ByRef Hoja As Object = Nothing) As Object
On Error GoTo EventoError
Dim Lng_IndexLibro&
Dim Lng_IndexHoja&
 
    If Index& <= 0 Then
        Index& = Excel.Workbooks.Count
    End If
 
    If Index& <= 0 And Hoja Is Nothing Then
        Index& = 1
        Set Libro = Excel.Workbooks.Add
        With Libro
            For Lng_IndexHoja& = 1 To .Worksheets.Count - 1
                .Worksheets(Lng_IndexHoja&).Delete
            Next
        End With
    Else
        If Hoja Is Nothing Then
            Set Libro = Excel.Workbooks(Index&)
        Else
            With Excel
                For Lng_IndexLibro& = 1 To .Workbooks.Count
                    With .Workbooks(Lng_IndexLibro&)
                        For Lng_IndexHoja& = 1 To .Worksheets.Count
                            If .Worksheets(Lng_IndexHoja&) Is Hoja Then
                                Set Libro = Excel.Workbooks(Lng_IndexHoja&)
                                Index& = Lng_IndexLibro&
                                Exit Property
                            End If
                        Next
                    End With
                Next
            End With
        End If
    End If
Exit Property
EventoError:
    RaiseEvent Errores(Err)
    Err.Clear
End Property
 
 
'   //  <Metodo Tipo = Propetiedad Acceso=Publico>
'   //      <Objetivo>
'   //          *   Obtiene una Hoja de libro segun los criterios.
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si no existen Libros se crea uno nuevo.
'   //          *   Si no existen Hojas se crea una nueva en el libro.
'   //          *   Si no se ingresa ningun parametro Opcional se crea un nuevo Libro, y Hoja son devueltos.
'   //      </Evaluaciones>
'   //      <Parametros>
'   //          <Opcional Nombre=Index& Datotipo=Long Predeterminado=-1>
'   //              indice de la Hoja a buscar!¡.
'   //              Si el parametro es superior a la cantidad de hojas en el libro o si es negativo
'   //              Creara una nueva Hoja.
'   //          </Opcional>
'   //          <Opcional Nombre=Book Datotipo=Object Predeterminado=Nothing>
'   //              Indica el libro donde se buscada, si se deja {Nothing} creara uno nuevo
'   //              y en el parametro {index&} devolvera la posicion de la hoja.
'   //          </Opcional>
'   //      </Parametros>
'   //      <Return Tipo=Object Parcial=Workbook>
'   //          Regresa la Hoja {Worksheets} Indicada.
'   //          Parametro {Book}    Regresa el libro en dado caso que no se aya indicado alguno.
'   //          PArametro {Index&}  Regresa el index de la hoja en el libro indicado en el parametro {Book}, igual si fuese Creado.
'   //          Regresa el
'   //      </Return>
'   //  </Metodo>
Public Property Get Hoja(Optional ByRef Index& = -1, Optional ByRef Book As Object = Nothing) As Object
On Error GoTo EventoError
Dim Lng_IndexLibro&
Dim Lng_IndexHoja&
 
    If Book Is Nothing Then
        Set Book = Libro(Index&)
    End If
    If Index& <= 0 Then
        Set Hoja = Book.Worksheets.Add
        Index& = Book.Worksheets.Count
    Else
        With Book
            If .Worksheets.Count < Index& Then
                Index& = .Worksheets.Count
            End If
            Set Hoja = .Worksheets(Index&)
        End With
    End If
 
Exit Property
EventoError:
    RaiseEvent Errores(Err)
    Err.Clear
End Property
Rem End Propiedades.
 
 
 
 
 
Rem Eventos de Modulo de Clase.
 
'   //  <Metodo Tipo=Proceso Acceso=Local>
'   //      <Objetivo>
'   //          *   Crea la instancia de la aplicacion!¡..
'   //      </Objetivo>
'   //  </Metodo>
Private Sub Class_Initialize()
On Error GoTo EventoError
    Set Obj_Excel = CreateObject("Excel.Application")
Exit Sub
EventoError:
    RaiseEvent Errores(Err)
    Err.Clear
End Sub
 
'   //  <Metodo Tipo=Proceso Acceso=Local>
'   //      <Objetivo>
'   //          *   Liberacion de Memoria.
'   //      </Objetivo>
'   //      <Evaluaciones>
'   //          *   Si hay libros abiertos o cargado los descarga.
'   //          *   Si existe la instancia de la aplicacion la clierra
'   //      </Evaluaciones>
'   //  </Metodo>
Private Sub Class_Terminate()
On Error Resume Next
Dim Lng_IndexLibro&
 
    With Excel
        For Lng_IndexLibro& = 1 To .Worksheets.Count
            .Worksheets(Lng_IndexLibro&).Close
            Set .Libro = Nothing
        Next
    End With
 
    If Not Obj_Excel Is Nothing Then
        Call Obj_Excel.Quit
        Set Obj_Excel = Nothing
    End If
    Err.Clear
End Sub
Rem End Eventos de Modulo de Clase.

Ejemplo!¡.

Código

 
'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   //            Ejemplo: Cls_ExcelAplication.cls             //
'   //                                                         //
'   /////////////////////////////////////////////////////////////
'
Option Explicit
 
Private WithEvents InstanciaExcel   As Cls_ExcelAplication      '   //  Solo para controlar Errores xP!¡.
 
Private Sub Form_Load()
'Dim InstanciaExcel                  As Cls_ExcelAplication     '   //  Declaracion Recomendada!¡.
Dim Obj_Hoja                        As Object
Const SaveOn$ = "c:\BlackZeroX.xls"
    Set InstanciaExcel = New Cls_ExcelAplication
    With InstanciaExcel
        Set Obj_Hoja = .Hoja                                    '   //  Creamos una libro y hoja
        Obj_Hoja.cells(1, 1) = "BlackZeroX"
        Obj_Hoja.cells(2, 1) = "Http://InfrAngeluX.sytes.net"
        Obj_Hoja.cells(3, 1) = "Dulce Infierno Lunar!¡."
        .Libro(, Obj_Hoja).Close True, SaveOn$                  '   //  Guardamos.
        Set Obj_Hoja = Nothing                                  '   //  Terminamos la instancia!¡.
    End With
    Set InstanciaExcel = Nothing
    Call vbShell(SaveOn$, False)
End Sub
Public Function vbShell(StrPath As String, Optional ByVal hHiden As Boolean = False) As Boolean
Dim ret                     As Object
    Set ret = CreateObject("Shell.Application", "")
    vbShell = Not ret Is Nothing
    If Not ret Is Nothing And CBool(Dir(StrPath) <> "") Then
        Call ret.ShellExecute(StrPath, "", "", "open", Abs(Not hHiden))
        Set ret = Nothing
    End If
End Function
 
 
Private Sub InstanciaExcel_Errores(ByRef Err As ErrObject)
    Call DebugerVB(Err)
End Sub
Private Sub DebugerVB(ByRef Err As ErrObject)
    With Err
        Debug.Print ""
        Debug.Print String$(30, "-")
        Debug.Print "Source:"; .Source
        Debug.Print "Number:"; .Number
        Debug.Print "Description:"; .Description
        Debug.Print String$(30, "-")
        Debug.Print ""
    End With
End Sub

Dulce Infierno Lunar!¡.