viernes, 20 de abril de 2012

Exportación de un Datagrid a excel de Office

Primero en el general del formulario se deben declarar las siguientes variables.

Dim Obj_Excel   As Object    
Dim Obj_Libro   As Object  
Dim Obj_Hoja    As Object 



Luego ponemos en un command la llamada a la función que nos va a ayudar a exportar el contenido del Datagrid.
Private Sub Command1_Click()
  ' -- Toma en cuenta que lo que esta sombreado en amarillo es el nombre del metodo a llamar
Call exporte_dtg(DataGrid1, DataGrid1.ApproxCount) 
End Sub  



Posteriormente en el general de tu formulario debes declarar el metodo y colocarle el siguiente codigo para realizar la exportación.
Private Sub exporte_dtg(Datagrid As Datagrid, n_Filas As Long)   
On Error GoTo Error_Handler
      
 Dim i   As Integer  
 Dim j   As Integer  
    
 ' -- Colocar el cursor de espera mientras se exportan los datos   
 Me.MousePointer = vbHourglass   
       
 If n_Filas = 0 Then  
 MsgBox "No hay datos para exportar a excel. Se ha indicado 0 en el parámetro Filas "Exit Sub  
  Else  
         
' -- Crear nueva instancia de Excel   
Set Obj_Excel = CreateObject("Excel.Application")   
' -- Agregar nuevo libro   
Set Obj_Libro = Obj_Excel.Workbooks.Open(Path)   
' -- Referencia a la Hoja activa ( la que añade por defecto Excel ) 
Set Obj_Hoja = Obj_Excel.ActiveSheet
iCol = 0
' --  Recorrer el Datagrid ( Las columnas )   
For i = 0 To Datagrid.Columns.Count - 1   
If Datagrid.Columns(i).Visible Then  
' -- Incrementar índice de columna   
iCol = iCol + 1   
' -- Obtener el caption de la columna   
Obj_Hoja.Cells(1, iCol) = Datagrid.Columns(i).Caption   
' -- Recorrer las filas   
For j = 0 To n_Filas - 1   
' -- Asignar el valor a la celda del Excel   
Obj_Hoja.Cells(j + 2, iCol) = _   
Datagrid.Columns(i).CellValue(Datagrid.GetBookmark(j))
Next  
End If  
Next  
 ' -- Hacer excel visible   
Obj_Excel.Visible = True
' -- Opcional : colocar en negrita y de color rojo los enbezados en la hoja   
With Obj_Hoja   
      .Rows(1).Font.Bold = True  
      .Rows(1).Font.Color = vbRed   
' -- Autoajustar las cabeceras   
      .Columns("A:Z").AutoFit   
End With  
End If    
' -- Eliminar las variables de objeto excel   
Set Obj_Hoja = Nothing  
Set Obj_Libro = Nothing  
Set Obj_Excel = Nothing  
' -- Restaurar cursor   
Me.MousePointer = vbDefault   
Exit Sub
' -- Error   
Error_Handler:
MsgBox Err.Description, vbCritical   
On Error Resume Next  
Set Obj_Hoja = Nothing  
Set Obj_Libro = Nothing  
Set Obj_Excel = Nothing  
Me.MousePointer = vbDefault
End  class="keyword">Sub  
Dim Obj_Libro   As Object  
Dim Obj_Hoja    As Object

6 comentarios:

  1. Excelente codigo. Solo corregi lo siguiente End class="keyword">Sub
    Dim Obj_Libro As Object
    Dim Obj_Hoja As Object
    y defini la variable iCol. Y funciono perfectamente.
    Gracias

    ResponderEliminar
  2. Me marca un error a la hora de apretar el command me dice run 13 type mismatch y me selecciona esta parte del codigo ayuda x favor Call exporte_dtg(DataGrid, DataGrid.ApproxCount)

    ResponderEliminar
  3. Me sale el error:

    No se Encontró "". Compruebe la ortografía del nombre del archivo y si su ubicación es correcta.

    ResponderEliminar
    Respuestas
    1. Asigna un valor a la variable path
      ejemplo: path="c:\test.xls"

      tambien al final donde libera los objetos yo hice este cambio
      Error_Handler:
      MsgBox Err.Description, vbCritical
      Set Obj_Hoja = Nothing
      Set Obj_Libro = Nothing
      Set Obj_Excel = Nothing
      On Error Resume Next

      porque mandaba un error

      espero te sirva. saludos

      Eliminar