Error al Exportar a Excel de un DataGrid - vb6.0
Publicado por Rubenssss (3 intervenciones) el 26/09/2008 17:00:17
Buenos días, tengo este problema, bueno implementé este codigo para poder exportar al excel desde un datagrid, el código esta en el menu principal (MDI) donde me permite exportar la primera vez, luego quiero hacerlo de nuevo y me sale de mensaje los siguiente: "Variable de Tipo Object o la variable de tipo With no est.a establecida". Bueno como les comento sólo me sale exportar a la primera vez de ejecutado el programa, a la segunda y sucesivamente sale ese mensaje y no exporta nada, para poder exportar otra cosa tengo q cerrar todo el programa y volver a ejecutar de nuevo, le doy varias vueltas al asunto y no encuentro la solución, espero que me ayuden, muchas gracias. El código es el siguiente:
Private Sub Exportar_Datagrid(Data_Grid As Datagrid, n_Filas As Long)
On Error GoTo ErrSub
'Variables para Excel
Dim Obj_Excel As Object
Dim Obj_Libro As Object
Dim Obj_Hoja As Object
Dim i As Long, j As Long, icol As Long
If n_Filas = 0 Then
MsgBox "No hay datos para exportar a excel": Exit Sub
Else
Set Obj_Excel = New Excel.Application
Set Obj_Libro = Excel.Workbooks.Add
Set Obj_Hoja = Excel.ActiveSheet
'Ponemos la aplicación excel visible
Obj_Excel.Visible = True
'Recorre el Datagrid
icol = 0
For i = 0 To Data_Grid.Columns.Count - 1
If Data_Grid.Columns(i).Visible Then
icol = icol + 1
'Caption de la columna
Obj_Hoja.Cells(1, icol) = Data_Grid.Columns(i).Caption
For j = 0 To n_Filas - 1
'asigna el valor a la celda del Excel
Obj_Hoja.Cells(j + 2, icol) = _
Data_Grid.Columns(i).CellValue(Data_Grid.GetBookmark(j))
Next
End If
Next
'Opcional : colocamos en negrita y de color rojo los enbezados en la hoja
Obj_Hoja.Rows(1).Font.Bold = True
Obj_Hoja.Rows(1).Font.Color = vbBlue
'Autoajustamos
Obj_Hoja.Columns("A:Z").AutoFit
'Guardamos el archivo
Obj_Excel.ActiveWorkbook.SaveAs FileName:=App.Path & "Exportados" & TABLA & "_" & FechaTex(Date) & ".xls"
'Si ocultas te la hoja de excel hayq ue visualizarla sino se queda la instancia abierta
Obj_Excel.Application.Visible = True
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
End If
'Eliminamos las variables de objeto excel
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
'Error
ErrSub:
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
MsgBox Err.Description, vbCritical
On Error Resume Next
End Sub
Donde llamo desde otro formulario hijo a ese procedimiento con:
Call Exportar_Datagrid(FrmMemos.Data1, FrmMemos.Data1.ApproxCount)
Y como ya saben sólo exporta la primera vez....Help me!!! gracias!
Private Sub Exportar_Datagrid(Data_Grid As Datagrid, n_Filas As Long)
On Error GoTo ErrSub
'Variables para Excel
Dim Obj_Excel As Object
Dim Obj_Libro As Object
Dim Obj_Hoja As Object
Dim i As Long, j As Long, icol As Long
If n_Filas = 0 Then
MsgBox "No hay datos para exportar a excel": Exit Sub
Else
Set Obj_Excel = New Excel.Application
Set Obj_Libro = Excel.Workbooks.Add
Set Obj_Hoja = Excel.ActiveSheet
'Ponemos la aplicación excel visible
Obj_Excel.Visible = True
'Recorre el Datagrid
icol = 0
For i = 0 To Data_Grid.Columns.Count - 1
If Data_Grid.Columns(i).Visible Then
icol = icol + 1
'Caption de la columna
Obj_Hoja.Cells(1, icol) = Data_Grid.Columns(i).Caption
For j = 0 To n_Filas - 1
'asigna el valor a la celda del Excel
Obj_Hoja.Cells(j + 2, icol) = _
Data_Grid.Columns(i).CellValue(Data_Grid.GetBookmark(j))
Next
End If
Next
'Opcional : colocamos en negrita y de color rojo los enbezados en la hoja
Obj_Hoja.Rows(1).Font.Bold = True
Obj_Hoja.Rows(1).Font.Color = vbBlue
'Autoajustamos
Obj_Hoja.Columns("A:Z").AutoFit
'Guardamos el archivo
Obj_Excel.ActiveWorkbook.SaveAs FileName:=App.Path & "Exportados" & TABLA & "_" & FechaTex(Date) & ".xls"
'Si ocultas te la hoja de excel hayq ue visualizarla sino se queda la instancia abierta
Obj_Excel.Application.Visible = True
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
End If
'Eliminamos las variables de objeto excel
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
'Error
ErrSub:
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
MsgBox Err.Description, vbCritical
On Error Resume Next
End Sub
Donde llamo desde otro formulario hijo a ese procedimiento con:
Call Exportar_Datagrid(FrmMemos.Data1, FrmMemos.Data1.ApproxCount)
Y como ya saben sólo exporta la primera vez....Help me!!! gracias!
Valora esta pregunta


0