Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - BlackZeroX

#2321
Te respondo el MP aquí.

Usa SQL puro y deja el PL/SQL (Creo que es este) has las consultas por ejemplo un ´pproceso que yo haria de forma nata.

Usaria Una Conexion ADO y tomaria los recorset de cada tabla.

* 1 RecordSet Tomaría los de la tabla Categorías (Son las que menor cantidad de registros tiene no es cierte xP).
* 1 Recorset que recorrería el 1 RecordSet con una Sentencia SQL del siguiente Tipo

Código (vb) [Seleccionar]


SQLSentense = "Select * from Productos where" & RecordSet.Fields(0).Name & "='" & RecordSet.Fields(0).Value & "' "



y almaceno o plasmo estos registros en el archivo de Excel directamente!¡.

Eso seria para el primera categoría o primer registro de tu tabla Categorias

después hacemos un RecordSet.MoveNext  y continuas asta no llegar a RecordSet.EOF o era .BOF no recuerdo cual de los dos xP o hasta RecordSet.MaxRecords del RecordSet Categorias!¡.

Si tienes problemas aquí estamos!¡.

Dulce Infierno Lunar!¡.
#2322
Cita de: hunter18 en 20 Junio 2010, 02:17 AM
Uhm!! ya veo asi era el asunto gracias por la aclaracion,estare pendiente haber cuando sale tu modulo de clase, saludos

http://foro.elhacker.net/programacion_visual_basic/srccls_clsexcelaplication_release_memory-t297215.0.html;msg1472257#msg1472257

Puedes usar en tu caso este!¡.

Código (vb) [Seleccionar]


'   //  Función para contar las Columnas REALES de un MSHFlexgrid.
Private Function GetColumns&(ByRef FlexGrid As MSHFlexGrid)
On Error GoTo Terminar
Dim Res$
    Res$ = Space(1)
    Do
        Res$ = FlexGrid.TextMatrix(0, GetColumns&)
        GetColumns& = GetColumns& + 1
    Loop Until Not Err.Number <= 0
Terminar:
    GetColumns& = GetColumns& - 1
    Err.Clear
End Function

'   //  Función para crear un nuevo libro con el contenido del MSHFlexgrid
Public Function Flexgrid_To_File_FormatExcel(ByVal sOutPutPath As String, ByRef FlexGrid As MSHFlexGrid) As Boolean
On Error GoTo Error_Handler
Dim InstanciaExcel              As Cls_ExcelAplication                      '   //  Contenedor de la aplicacion Excel Con {Liberacion de Memoria} al descargar!¡).
Dim Obj_Hoja                    As Object
Dim Lng_UbHojas&
Dim Fila&
Dim TmpStr$
Dim Columna&
Dim CantCols&
    Set InstanciaExcel = New Cls_ExcelAplication                            '   //  Crea el objeto Excel,   (Con {Liberacion de Memoria} Automatica)
    If Not InstanciaExcel Is Nothing Then
        With InstanciaExcel
            Set Obj_Hoja = .Hoja                                            '   //  Creamos una nueva Hoja
            CantCols = GetColumns&(FlexGrid)
            With FlexGrid
                For Fila = 1 To .Rows - 1                                   '   //  Bucle para Exportar los datos.
                    For Columna = 0 To CantCols&                            '   //  Bucle para Exportar los datos.
                        TmpStr$ = .TextMatrix(Fila, Columna)                                                                                                                                                                                                         '   //  Texto de Celda.
                        If IsNumeric(TmpStr$) Then TmpStr$ = "'" & TmpStr$  '   //  Si es numero lo exportamos como tal {Seria como comentario...} !¡.
                        Obj_Hoja.cells(Fila, Columna + 1).Value = TmpStr$
                    Next
                Next
            End With
            Call .Libro(, Obj_Hoja).Close(True, sOutPutPath)
            Set Obj_Hoja = Nothing
        End With
    End If
Error_Handler:
    Set InstanciaExcel = Nothing                                            '   //  Se descarga la clase y la aplicacion Excel automaticamente.
    Flexgrid_To_File_FormatExcel = Not CBool(Err.Number)
    Call Err.Clear
End Function



Dulce Infierno Luanr!¡.
#2323
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]

'
'   /////////////////////////////////////////////////////////////
'   // 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]


'
'   /////////////////////////////////////////////////////////////
'   // 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!¡.
#2324
Cita de: hunter18 en 19 Junio 2010, 18:33 PM
Finalmente podrian comentar como trabaja la funcion  GetColumns y tambien por que solo tomaba las dos primeras columnas las cuales estaban agrupadas si supuestamente MSHFlexGrid1.Cols recupera el numero de columnas de los encabezados?, de todas maneras voy a revisar el codigo.

Lo que pasa es que .Cols te va a devolver lo de tu primer FlexGrid aqui hay dos bueno se puede decir que son dos!¡ FlexGrid solo que anidados segun tu sentencia SQL (creo que es PL/SQL peo no estoy seguro...)

Bien bien si ven en el FlexGrid tiene los signos de -/+ para contraer los datos bueno cuando se contraen se muestran las Verdades Columnas del FlexGrid es decir de tu tabla categorias y los que fueron contraidos son los de tu tabla de Productos o algo asi se llamaban xP jeje. Bien la cosa es que solo va a contar las columnas de tu primera sentencia es decir de tu Tabla Columnas tal cual se lo as indicado en tu sentencia SQL

P.D.: NO TIENE NADA QUE VER la relacion de tablas dentro de Access o de una Base de datos, ya que una sentencia SQL puede ignorar (en este caso lo hace) las relaciones.

Nota:
-> * Es mejor hacer un modulo de Clase para contener el objecto de Excel, ya que si la funcion se ve interrumpida o terminada la aplicacion por X motivo el Release Memory no se ejecutara (Ando haciendo un modulo de Clase pequeño y ergonomico cuando lo acabe lo publico en un nuevo Tema)!¡.

Dulce Infierno Lunar!¡.
#2325
Se me olvido Usa GESHI!¡.



Dulce Infierno Lunar!¡.
#2326
Bueno la cosa es que en el FlexGrid cols da solo la cantidad de 2 es decir de tu tabla de Categorias pero no toma encuenta las demas con un simple proceso se soluciona!¡.

Código (vb) [Seleccionar]



Option Explicit

Private WithEvents TmpAdoConector              As Cls_AdoConector      '   //  Modulo de clase para trabajar de forma limpia sobre el codigo xP.

' -------------------------------------------------------------------------------------------
' \\ -- Función para contar las Columnas REALES de un MSHFlexgrid.
' -------------------------------------------------------------------------------------------
Private Function GetColumns&(ByRef FlexGrid As MSHFlexgrid)
On Error GoTo Terminar
Dim Res$
   Res$ = Space(1)
   Do
       Res$ = FlexGrid.TextMatrix(0, GetColumns&)
       GetColumns& = GetColumns& + 1
   Loop Until Not Err.Number <= 0
Terminar:
   GetColumns& = GetColumns& - 1
   Err.Clear
End Function
' -------------------------------------------------------------------------------------------
' \\ -- Función para crear un nuevo libro con el contenido del MSHFlexgrid
' -------------------------------------------------------------------------------------------
Public Function Flexgrid_To_File_FormatExcel(ByVal sOutPutPath As String, ByRef FlexGrid As MSHFlexgrid) As Boolean
On Error GoTo Error_Handler
Dim Obj_Excel       As Object
Dim Obj_Libro       As Object
Dim Obj_Hoja        As Object
Dim Fila&
Dim TmpStr$
Dim Columna&
Dim CantCols&
     
   ' -- Crea el objeto Excel, el objeto workBook y el objeto sheet
   Set Obj_Excel = CreateObject("Excel.Application")
   If Not Obj_Excel Is Nothing Then
       Set Obj_Libro = Obj_Excel.Workbooks.Add
       If Not Obj_Libro Is Nothing Then
           Set Obj_Hoja = Obj_Libro.Worksheets.Add
           If Not Obj_Hoja Is Nothing Then
               
               ' -- Bucle para Exportar los datos
               CantCols = GetColumns&(FlexGrid)
               With FlexGrid
                   For Fila = 1 To .Rows - 1
                       For Columna = 0 To CantCols&
                           TmpStr$ = .TextMatrix(Fila, Columna)
                           If IsNumeric(TmpStr$) Then TmpStr$ = "'" & TmpStr$
                           Obj_Hoja.Cells(Fila, Columna + 1).Value = TmpStr$
                       Next
                   Next
               End With
               
               Obj_Libro.Close True, sOutPutPath
               Call Obj_Excel.Quit
               
               Set Obj_Hoja = Nothing
               Set Obj_Libro = Nothing
               Set Obj_Excel = Nothing
               
               Flexgrid_To_File_FormatExcel = True
               
           End If
       End If
   End If
   Exit Function
Error_Handler:
   Flexgrid_To_File_FormatExcel = False
   Call Err.Clear
End Function



Private Sub Cmd_Export_Click()
   Call MsgBox(IIf(Flexgrid_To_File_FormatExcel("C:\Excel.xls", MS_DataGrid), "Exportacion Exitosa", "Exportacion Fallida"))
End Sub

Private Sub Cmd_LoadData_Click()
'Dim TmpAdoConector              As Cls_AdoConector      '   //  Modulo de clase para trabajar de forma limpia sobre el codigo xP.
Dim TmpRecordSet                As ADODB.Recordset

   Set TmpAdoConector = New Cls_AdoConector
   With TmpAdoConector
       .ConectionType = Other
       .ConnectionString = "Provider               =   MSDataShape.1;" & _
                           "Extended Properties    =   Jet OLEDB:Database Password=;" & _
                           "Persist Security Info  =   False;" & _
                           "Data Source            =   c:\bd_01.mdb;" & _
                           "Data Provider          =   MICROSOFT.JET.OLEDB.4.0"
       Set TmpRecordSet = .GetNew_RecordSet( _
                                           "SHAPE {SELECT codcat,nomcat FROM categoria} AS CABECERA " & _
                                           "APPEND ({SELECT codprod,nomprod,codcat FROM producto} AS DETALLE " & _
                                           "RELATE codcat TO codcat) AS DETALLE" _
                                           )
       If Not TmpRecordSet Is Nothing Then
           Set MS_DataGrid.DataSource = TmpRecordSet
           With TmpRecordSet
               Call .Close
               Call .ActiveConnection.Close
           End With
           Set TmpRecordSet = Nothing
       End If
   End With
   Set TmpAdoConector = Nothing
End Sub

Private Sub TmpAdoConector_ErrorEvent(InfoError 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!¡.
#2327

Podrias poner un archivo ".mdb" aquí, nunca he tenido que procesar un MSHFlexgrid1 con celdas combinadas ( es para ayudarte!¡. )

P.D.: No tengo Access ni nada de Offices por aqui xP.

Dulce Infierno Lunar!¡.
#2328
Cita de: *PsYkE1* en 17 Junio 2010, 02:49 AM
Esto no es necesario, buscar en todos los controles y comprobar si es un TextBox?¿
¿Y por que no con una matriz de controles:huh:
Asi, en practicamente una linea:

Código (vb) [Seleccionar]


Dim x As Integer
'Suponiendo que tengamos 5 TextBox (el 0 cuenta)
For x = 0 to 4 : Text1(x).Text = vbNullString : Next



que no seria asi?

Código (vb) [Seleccionar]


Dim x As Integer
'Suponiendo que tengamos 5 TextBox (el 0 cuenta)
For x = tex1.lbound to tex1.ubound
    Text1(x).Text = vbNullString
Next



El For Next no se entiende si se pone en una sola linea xP...

Ahora es mejor con un For Each por que si te actualizas a VB .NET ya NO HAY MATRIX DE CONTROLES  (yo me las arreglo con un modulo de clase y pasando estos controles del mismo tipo a un object de tipo Array y me va de lujo xP, solo son unos pasitos mas xP jeje...)

Dulce Infierno Lunar!¡.
#2329
Es vba, vbs no importa cuando se el wscript lleva el control de los objetos!¡.

Por ello un script puede llevar cuantos errores y lo unico que hara sera su trabajo!¡, en cambio en un lenguaje que se compile afuerzas debes estar liberando la memoria... creo que en vb .NET ya no es tan nesesario ( Flojos!¡ ).

Dulce Infierno Lunar!¡.
#2330
Hardware / Re: [overclocking] Problemas....
16 Junio 2010, 20:44 PM
Disculpen el Doble Post!¡.

Aqui las imagenes de la Bios!¡.










Dulce Infienro Lunar!¡.