Excel-Visual basic

Más sobre el tema en
http://it.internations.net/codigovb/Ficheros/ExtraerExcel.htm
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 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