Error con Excel
El problema surge volcando datos con formato a Excel desde VB (por ejemplo establecer un fondo de color a una celda) La primera vez funciona correctamente. Abro objeto Excel Application, vuelco los datos, cierro el objeto Excel Application... todo Ok. Pero si pretendo ejecutarlo otra vez, vuelca los datos pero sin el formato. ¿A que se debe? ¿Como solventarlo? Gracias
A mi me funciona perfectamente. ¿puedes pegar el codigo para ver si veo algo?
Bueno, la verdad es que es bastante. Simplificaré un poco el código:
Parto de un formulario del que se generarán los sucesivosa EXCEL. En un formulario pongo un Common Dialog para obtener un nombre del fichero (vale cualquiera que le quieras poner luego, pero que sea distinto nombre) y un botón. Al pulsar el botón, llamo a la siguiente función pasándole el Dialog de parámetro (todo esto se puede obviar):
Public Sub grabarEnExcel(comDlg As Control)
Dim i As Integer
Dim j As Integer
Dim sArchivo As String
On Error GoTo DialogError
With comDlg
.CancelError = False
.Filter = "Formato Excel (*.xls)|*.xls"
.FilterIndex = 1
.DialogTitle = "Escriba el nombre del archivo en el que guardará los resultados"
.ShowSave
If .FileName = "" Then
Exit Sub
Else
sArchivo = .FileName
End If
End With
On Error GoTo ErrorGenerando
'Este procedimiento será el siguiente
Call EscribeXls("Informe a " & CStr(Date), sArchivo)
Exit Sub
DialogError:
MsgBox Err.Description
Exit Sub
ErrorGenerando:
MsgBox Err.Description
End Sub
'*******
Private Sub EscribeXls(title1 As String, sArchivo As String)
Dim i As Integer
Dim j As Integer
Dim nws As Integer
Dim counter As Integer
Dim excelapp As Excel.Application
Dim excelsheet As Workbook
On Error GoTo ErrorGrabandoEXCEL
Set excelapp = CreateObject("excel.application")
Set excelsheet = excelapp.Workbooks.Add
nws = (excelsheet.Worksheets.Count)
If nws < 5 Then
nws = 5 - nws
excelsheet.Worksheets.Add Count:=nws
End If
'Proceso de la hoja uno excelsheet.Worksheets(1).Activate
'Luego se llama a este procedimiento
Call ProcesarHojaExcelResultadosSectoriales(excelsheet.Worksheets(1), title1)
'Irían más procedimientos como el anterior, uno por hoja del libro con diferentes datos
'Proceso de la hoja de Componentes Producción
On Error GoTo ControladorErrores
excelsheet.SaveAs sArchivo 'filename was declared in Module1 as a public string
On Error GoTo 0
excelsheet.Worksheets(1).Activate
excelapp.Visible = True
'excelsheet.Application.Quit
Set excelsheet = Nothing
Set excelapp = Nothing
Exit Sub
ErrorGrabandoEXCEL:
MsgBox "Error volcando los datos. " & Err.Description, vbInformation, "Atención"
Exit Sub
ControladorErrores:
MsgBox "Error : " & Err.Description
End Sub
'***********
Este procedimiento escribe muchas más líneas en la hoha EXCEL. Solo he dejado los que se llamarán para ser marcados.
Public Sub ProcesarHojaExcelResultadosSectoriales(xHoja As Excel.Worksheet, title1 As String)
On Error GoTo errorResultadosSectoriales
'Comienzo de la primera hoja
With xHoja
.Name = "Resultados Sectoriales"
.Cells(1, 3).Value = title1
'Procedimiento que formatea celdas
Call pMarcarCelda(.Cells(2, 1), NARANJA, "PRODUCCION")
Call pMarcarCelda(.Cells(3, 1), GRIS, "Rama")
Call pMarcarCelda(.Cells(3, 2), GRIS, "Esc. Base")
Call pMarcarCelda(.Cells(3, 3), GRIS, "Simulación")
Call pMarcarCelda(.Cells(3, 4), GRIS, "Dif % ")
Call pMarcarCelda(.Cells(2, 6), NARANJA, "PRECIOS")
Call pMarcarCelda(.Cells(3, 6), GRIS, "Rama")
Call pMarcarCelda(.Cells(3, 7), GRIS, "Esc. Base")
Call pMarcarCelda(.Cells(3, 8), GRIS, "Simulación")
Call pMarcarCelda(.Cells(3, 9), GRIS, "Dif % ")
.Columns(1).EntireColumn.AutoFit
.Columns(6).EntireColumn.AutoFit
End With
Set xHoja = Nothing
Exit Sub
errorResultadosSectoriales:
MsgBox "Error volcando datos de Resultados Sectoriales." & Err.Description, vbInformation
End Sub
'************
Si tienes cualquier duda o problema no dudes en hacérmelo saber. Muchas gracias de antemano por tu interés.
Public Sub pMarcarCelda(xCelda As Range, iColor As Integer, Optional sTexto As String)
On Error GoTo ErrorMarcandoCelda
xCelda.Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Negrita"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = iColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
If sTexto <> "" Then
xCelda.Value = sTexto
End If
Exit Sub
ErrorMarcandoCelda:
MsgBox "Error marcando celda: " & Err.Description, vbError
End Sub
Parto de un formulario del que se generarán los sucesivosa EXCEL. En un formulario pongo un Common Dialog para obtener un nombre del fichero (vale cualquiera que le quieras poner luego, pero que sea distinto nombre) y un botón. Al pulsar el botón, llamo a la siguiente función pasándole el Dialog de parámetro (todo esto se puede obviar):
Public Sub grabarEnExcel(comDlg As Control)
Dim i As Integer
Dim j As Integer
Dim sArchivo As String
On Error GoTo DialogError
With comDlg
.CancelError = False
.Filter = "Formato Excel (*.xls)|*.xls"
.FilterIndex = 1
.DialogTitle = "Escriba el nombre del archivo en el que guardará los resultados"
.ShowSave
If .FileName = "" Then
Exit Sub
Else
sArchivo = .FileName
End If
End With
On Error GoTo ErrorGenerando
'Este procedimiento será el siguiente
Call EscribeXls("Informe a " & CStr(Date), sArchivo)
Exit Sub
DialogError:
MsgBox Err.Description
Exit Sub
ErrorGenerando:
MsgBox Err.Description
End Sub
'*******
Private Sub EscribeXls(title1 As String, sArchivo As String)
Dim i As Integer
Dim j As Integer
Dim nws As Integer
Dim counter As Integer
Dim excelapp As Excel.Application
Dim excelsheet As Workbook
On Error GoTo ErrorGrabandoEXCEL
Set excelapp = CreateObject("excel.application")
Set excelsheet = excelapp.Workbooks.Add
nws = (excelsheet.Worksheets.Count)
If nws < 5 Then
nws = 5 - nws
excelsheet.Worksheets.Add Count:=nws
End If
'Proceso de la hoja uno excelsheet.Worksheets(1).Activate
'Luego se llama a este procedimiento
Call ProcesarHojaExcelResultadosSectoriales(excelsheet.Worksheets(1), title1)
'Irían más procedimientos como el anterior, uno por hoja del libro con diferentes datos
'Proceso de la hoja de Componentes Producción
On Error GoTo ControladorErrores
excelsheet.SaveAs sArchivo 'filename was declared in Module1 as a public string
On Error GoTo 0
excelsheet.Worksheets(1).Activate
excelapp.Visible = True
'excelsheet.Application.Quit
Set excelsheet = Nothing
Set excelapp = Nothing
Exit Sub
ErrorGrabandoEXCEL:
MsgBox "Error volcando los datos. " & Err.Description, vbInformation, "Atención"
Exit Sub
ControladorErrores:
MsgBox "Error : " & Err.Description
End Sub
'***********
Este procedimiento escribe muchas más líneas en la hoha EXCEL. Solo he dejado los que se llamarán para ser marcados.
Public Sub ProcesarHojaExcelResultadosSectoriales(xHoja As Excel.Worksheet, title1 As String)
On Error GoTo errorResultadosSectoriales
'Comienzo de la primera hoja
With xHoja
.Name = "Resultados Sectoriales"
.Cells(1, 3).Value = title1
'Procedimiento que formatea celdas
Call pMarcarCelda(.Cells(2, 1), NARANJA, "PRODUCCION")
Call pMarcarCelda(.Cells(3, 1), GRIS, "Rama")
Call pMarcarCelda(.Cells(3, 2), GRIS, "Esc. Base")
Call pMarcarCelda(.Cells(3, 3), GRIS, "Simulación")
Call pMarcarCelda(.Cells(3, 4), GRIS, "Dif % ")
Call pMarcarCelda(.Cells(2, 6), NARANJA, "PRECIOS")
Call pMarcarCelda(.Cells(3, 6), GRIS, "Rama")
Call pMarcarCelda(.Cells(3, 7), GRIS, "Esc. Base")
Call pMarcarCelda(.Cells(3, 8), GRIS, "Simulación")
Call pMarcarCelda(.Cells(3, 9), GRIS, "Dif % ")
.Columns(1).EntireColumn.AutoFit
.Columns(6).EntireColumn.AutoFit
End With
Set xHoja = Nothing
Exit Sub
errorResultadosSectoriales:
MsgBox "Error volcando datos de Resultados Sectoriales." & Err.Description, vbInformation
End Sub
'************
Si tienes cualquier duda o problema no dudes en hacérmelo saber. Muchas gracias de antemano por tu interés.
Public Sub pMarcarCelda(xCelda As Range, iColor As Integer, Optional sTexto As String)
On Error GoTo ErrorMarcandoCelda
xCelda.Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Negrita"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = iColor
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
If sTexto <> "" Then
xCelda.Value = sTexto
End If
Exit Sub
ErrorMarcandoCelda:
MsgBox "Error marcando celda: " & Err.Description, vbError
End Sub
Yo utilizo siempre el objeto Excel(excelapp), el objeto excelsheet no lo utilizo para nada.
Lo que hago es entrar en Excel, Herraminetas, Crear nueva macro y hacer lo mismo que quieres hacer en el programa y grabo la Macro.
Entro en Herraminetas, Macros, modificar y hago un copy del codigo VB y añado por delante de las sentencias el Objeto Excel (en tu caso excelapp)
Cuando lo hacia con objetos Workbook me daba los mismos problemas que a ti.
Las diferencias que veo a primera vista, con lo que hago yo, son las siguientes
YO:
excelapp.Sheets.Count
excelapp.Sheets("Hoja1").Select
TU:
excelsheet.Worksheets.Count
excelsheet.Worksheets(1).Activate
Para asignar valores a las celdas
excelapp.Cells(2, 2) = "xxxxxxxxxxxxx"
Para seleccionar celdas
excelapp.Range("A2:B4").Select
With excelapp.Selection.Font
.Name = "Arial"
......... ETC
ESPERO QUE TE SIRVA
Lo que hago es entrar en Excel, Herraminetas, Crear nueva macro y hacer lo mismo que quieres hacer en el programa y grabo la Macro.
Entro en Herraminetas, Macros, modificar y hago un copy del codigo VB y añado por delante de las sentencias el Objeto Excel (en tu caso excelapp)
Cuando lo hacia con objetos Workbook me daba los mismos problemas que a ti.
Las diferencias que veo a primera vista, con lo que hago yo, son las siguientes
YO:
excelapp.Sheets.Count
excelapp.Sheets("Hoja1").Select
TU:
excelsheet.Worksheets.Count
excelsheet.Worksheets(1).Activate
Para asignar valores a las celdas
excelapp.Cells(2, 2) = "xxxxxxxxxxxxx"
Para seleccionar celdas
excelapp.Range("A2:B4").Select
With excelapp.Selection.Font
.Name = "Arial"
......... ETC
ESPERO QUE TE SIRVA
