Generar archivo de Excel en VB

Hola Deseo generar un archivo de Excel en VB

1 Respuesta

Respuesta
1
Prueba con la siguiente rutina:
Private Sub Exporta_Excel()
Dim oObjetoExcel As Object
Dim icol As Integer
Dim iContRengDatos As Integer
Dim iContRengExcel As Integer
Dim iResult As Integer
Dim pszCelda As Variant
On Local Error GoTo Muestra_Error
'Título del diálogo
mdiPrincipal!dlgGeneralMDI.DialogTitle = "Exportar Archivo..."
'Se inicializa el Nombre del Archivo
mdiPrincipal!dlgGeneralMDI.FileName = NULL_STRING
mdiPrincipal!dlgGeneralMDI.CancelError = False
'Tamaño Máximo del Archivo
mdiPrincipal!dlgGeneralMDI.MaxFileSize = 30000
'Tipos de Archivos
mdiPrincipal!dlgGeneralMDI.Filter = "Excel (*.xls)|*.xls"
'Extensión por Default
mdiPrincipal!dlgGeneralMDI.DefaultExt = ".xls"
'Banderas
mdiPrincipal!dlgGeneralMDI.FLAGS = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Or OFN_CREATEPROMPT Or OFN_OVERWRITEPROMPT Or OFN_NOREADONLYRETURN
Call Muestra_Mensaje_En_Linea("Salvar archivo...")
'Acción de Salvar el Archivo
mdiPrincipal!dlgGeneralMDI.Action = DLG_FILE_SAVE
If (mdiPrincipal!dlgGeneralMDI.FileName <> NULL_STRING) Then
Call Muestra_Mensaje_En_Linea("Estableciendo Comunicación con Microsoft Excel...")
'Se crea el Objeto
Set oObjetoExcel = CreateObject("Excel.sheet")
Call Muestra_Mensaje_En_Linea("Comunicación Establecida")
'Se posiciona al Spred de Datos en el primer renglón
sprDatos.Row = NULL_INTEGER
'Se asigna el ancho de las columnas
For icol = 1 To sprDatos.MaxCols
oObjetoExcel.Application.Cells(icol).ColumnWidth = sprDatos.ColWidth(icol)
Next
'Se pone el Título en Azul en el renglón 4, porque son 3 renglones para los parámetros
'For iCol = 1 To sprDatos.MaxCols
' oObjetoExcel.Cells(4, iCol).Font.Color = BLUE
'Next
Call Muestra_Mensaje_En_Linea("Exportando Datos...")
'Se exportan los datos del Spread de Parámetros
iContRengExcel = 1
For iContRengDatos = 1 To sprParametros.MaxRows
For icol = 1 To sprParametros.MaxCols
'iResult = Spreadgettext(sprParametros, icol, iContRengDatos, pszCelda)
iResult = sprParametros.GetText(icol, iContRengDatos, pszCelda)
oObjetoExcel.Application.Cells(iContRengExcel, icol).Value = pszCelda
Next
iContRengExcel = iContRengExcel + 1
Next
'Se exportan los datos del Spread de Datos
For iContRengDatos = NULL_INTEGER To sprDatos.MaxRows
For icol = 1 To sprDatos.MaxCols
'iResult = Spreadgettext(sprDatos, icol, iContRengDatos, pszCelda)
iResult = sprDatos.GetText(icol, iContRengDatos, pszCelda)
oObjetoExcel.Application.Cells(iContRengExcel, icol).Value = pszCelda
Next
iContRengExcel = iContRengExcel + 1
Next
Call Muestra_Mensaje_En_Linea("Exportación Finalizada")
'Se salva a un Archivo el Objeto
oObjetoExcel.SaveAs mdiPrincipal!dlgGeneralMDI.FileName
End If
Call Muestra_Mensaje_En_Linea("Listo")
Exit Sub
Muestra_Error:
Call Muestra_Error_OLE
Exit Sub
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas