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

[BlackZeroX]

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 (vb) [Seleccionar] Expandir


'
'   /////////////////////////////////////////////////////////////
'   // 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 (vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   // 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!¡.