La Web del Programador: Comunidad de Programadores
 
    Pregunta:  61877 - TRASLADO DE REPORTE A EXCEL 2003
Autor:  marcela perez
hola a todos necesito ayuda con esto soy nueva en reportes y necesitio trasladar un reporte por medio de un boton el reporte tiene sub totales logro parsarlo a excel pero sin esos sub totales

boton:
Private Sub BtnTrasladoExcel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnTrasladoExcel.Click

'' excel 2003
Dim oExcel As Excel.ApplicationClass
Dim oBooks As Excel.Workbooks
Dim oBook As Excel.WorkbookClass
Dim oSheet As Excel.Worksheet

'' Inicia Excel y abre el workbook
oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oBooks = oExcel.Workbooks
oBook = oExcel.Workbooks.Add
oSheet = oBook.Sheets(1)

Const ROW_FIRST = 2
Dim iRow As Int64 = 1

'' Encabezado
oSheet.Cells(ROW_FIRST, 1) = "CODIGO"
oSheet.Cells(ROW_FIRST, 2) = "CUENTA"
oSheet.Cells(ROW_FIRST, 3) = "ENERO"
oSheet.Cells(ROW_FIRST, 4) = "FEBRERO"
oSheet.Cells(ROW_FIRST, 5) = "MARZO"
oSheet.Cells(ROW_FIRST, 6) = "ABRIL"
oSheet.Cells(ROW_FIRST, 7) = "MAYO"
oSheet.Cells(ROW_FIRST, 8) = "JUNIO"
oSheet.Cells(ROW_FIRST, 9) = "ACUMULADO"

oSheet.Columns(1).ColumnWidth = 10
oSheet.Columns(2).ColumnWidth = 40
oSheet.Columns(3).ColumnWidth = 15
oSheet.Columns(4).ColumnWidth = 15
oSheet.Columns(5).ColumnWidth = 15
oSheet.Columns(6).ColumnWidth = 15
oSheet.Columns(7).ColumnWidth = 15
oSheet.Columns(8).ColumnWidth = 15
oSheet.Columns(9).ColumnWidth = 15

'' Loop que almacena los datos
Dim rowCustomer As DSReportesFinancieros.ReportesFinancierosResultadosMensualAnualRow
For Each rowCustomer In Me.DsReportesFinancieros1.ReportesFinancierosResultadosMensualAnual
Dim iCurrRow As Int64 = ROW_FIRST + iRow + 1

oSheet.Cells(iCurrRow, 1) = rowCustomer.codigo_cuenta_contable
oSheet.Cells(iCurrRow, 2) = rowCustomer.nombre_cuenta_contable
' oSheet.Cells(iCurrRow, 3) = rowCustomer.mes01
If rowCustomer.IsNull("mes01") = True Then
oSheet.Cells(iCurrRow, 3) = ""
Else
oSheet.Cells(iCurrRow, 3) = rowCustomer.mes01
End If
If rowCustomer.IsNull("mes02") = True Then
oSheet.Cells(iCurrRow, 4) = ""
Else
oSheet.Cells(iCurrRow, 4) = rowCustomer.mes02
End If
If rowCustomer.IsNull("mes03") = True Then
oSheet.Cells(iCurrRow, 5) = ""
Else
oSheet.Cells(iCurrRow, 5) = rowCustomer.mes03
End If
If rowCustomer.IsNull("mes04") = True Then
oSheet.Cells(iCurrRow, 6) = ""
Else
oSheet.Cells(iCurrRow, 6) = rowCustomer.mes04
End If
If rowCustomer.IsNull("mes05") = True Then
oSheet.Cells(iCurrRow, 7) = ""
Else
oSheet.Cells(iCurrRow, 7) = rowCustomer.mes05
End If
If rowCustomer.IsNull("mes06") = True Then
oSheet.Cells(iCurrRow, 8) = ""
Else
oSheet.Cells(iCurrRow, 8) = rowCustomer.mes06
End If
If rowCustomer.IsNull("acumulado") = True Then
oSheet.Cells(iCurrRow, 9) = ""
Else
oSheet.Cells(iCurrRow, 9) = rowCustomer.acumulado
End If

iRow += 1
Next

'' Fórmula
oSheet.Cells(ROW_FIRST + iRow + 1, 3) = "=SUMA(C" & (ROW_FIRST + 1) & ".." & "C" & (ROW_FIRST + iRow - 1) & ")"

''Guardar
oExcel.Application.ActiveWorkbook.SaveAs("E:reporte.xls")
MessageBox.Show("Finalizado", " Verificación ", MessageBoxButtons.OK, MessageBoxIcon.Information)

  Respuesta:  WALTER DANIEL PARRAGA
lo hice de la siguiente forma:

Dim colum As Integer

Dim m_Excel As New Excel.Application
m_Excel.Cursor = Excel.XlMousePointer.xlWait
m_Excel.Visible = True
Dim objLibroExcel As Excel.Workbook = m_Excel.Workbooks.Add
Dim objHojaExcel As Excel.Worksheet = objLibroExcel.Worksheets(1)
With objHojaExcel
.Visible = Excel.XlSheetVisibility.xlSheetVisible
.Activate()

''Estilo a titulos de la tabla
.Range("A1").HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.Range("A1:F1").Merge()
.Range("A1:F1").Value = "GAD MUNICIPAL"
.Range("A1:F1").Font.Bold = True
.Range("A1:F1").Font.Size = 16
.Range("A2").HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
.Range("A2:F2").Merge()
.Range("A2:F2").Value = "DEPOSITOS DE RECAUDACIÓN DE IMPUESTOS"
.Range("A2:F2").Font.Bold = True
.Range("A2:F2").Font.Size = 12
.Range("A3").HorizontalAlignment = Excel.XlHAlign.xlHAlignRight
.Range("A3").Value = "DESDE:"
.Range("A3").Font.Bold = True
.Range("B3").Value = Format(dtpdesde.Value, "dd/MM/yyyy")
.Range("C3").HorizontalAlignment = Excel.XlHAlign.xlHAlignRight
.Range("C3").Value = "HASTA:"
.Range("C3").Font.Bold = True
.Range("D3").HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft
.Range("D3:E3").Merge()
.Range("D3:E3").Value = Format(dtphasta.Value, "dd/MM/yyyy")

Const primeraLetra As Char = "A"
Const primerNumero As Short = 4
Dim Letra As Char, UltimaLetra As Char
Dim Numero As Integer, UltimoNumero As Integer
Dim cod_letra As Byte = Asc(primeraLetra) - 1
Dim strColumna As String = ""
Dim LetraIzq As String = ""
Dim cod_LetraIzq As Byte = Asc(primeraLetra) - 1
Letra = primeraLetra
Numero = primerNumero
Dim objCelda As Excel.Range
For Each c As DataGridViewColumn In gridat.Columns

If c.Visible Then
: If Letra = "Z" Then
Letra = primeraLetra
cod_letra = Asc(primeraLetra)
cod_LetraIzq += 1
LetraIzq = Chr(cod_LetraIzq)
Else
cod_letra += 1
Letra = Chr(cod_letra)
End If
strColumna = LetraIzq + Letra + Numero.ToString
objCelda = .Range(strColumna, Type.Missing)
objCelda.Value = c.HeaderText
objCelda.EntireColumn.Font.Size = 10
End If
Next
Dim objRangoEncab As Excel.Range = .Range(primeraLetra + Numero.ToString, LetraIzq + Letra + Numero.ToString)
objRangoEncab.BorderAround(1, Excel.XlBorderWeight.xlMedium)
UltimaLetra = Letra
Dim UltimaLetraIzq As String = LetraIzq
'Cargar Datos del DataGridView.
Dim i As Integer = Numero + 1
colum = i
For Each reg As DataGridViewRow In gridat.Rows
LetraIzq = ""
cod_LetraIzq = Asc(primeraLetra) - 1
Letra = primeraLetra
cod_letra = Asc(primeraLetra) - 1
For Each c As DataGridViewColumn In gridat.Columns
If c.Visible Then
If Letra = "Z" Then
Letra = primeraLetra
cod_letra = Asc(primeraLetra)
cod_LetraIzq += 1
LetraIzq = Chr(cod_LetraIzq)
Else
cod_letra += 1
Letra = Chr(cod_letra)
End If
strColumna = LetraIzq + Letra
'Aqui se realiza la carga de datos.
.Cells(i, strColumna) = IIf(IsDBNull(reg.ToString), "", reg.Cells(c.Index).Value)
End If
Next
Dim objRangoReg As Excel.Range = .Range(primeraLetra + i.ToString, strColumna + i.ToString)
objRangoReg.Rows.BorderAround()
objRangoReg.Select()
i += 1
Next

''FORMULA PARA SUMA
Dim sumacelda As String
sumacelda = Microsoft.VisualBasic.Right(strColumna & i, 5)
.Range(sumacelda).Value = "=SUMA(F" & colum & ".." & "F" & i - 1 & ")"
.Range(sumacelda).Font.Bold = True
.Range(sumacelda).Font.Size = 12

UltimoNumero = i
'Dibujar las líneas de las columnas.
LetraIzq = ""
cod_LetraIzq = Asc("A")
cod_letra = Asc(primeraLetra)
Letra = primeraLetra
For Each c As DataGridViewColumn In gridat.Columns
If c.Visible Then
objCelda = .Range(LetraIzq + Letra + primerNumero.ToString, LetraIzq + Letra + (UltimoNumero - 1).ToString)
objCelda.BorderAround()
If Letra = "Z" Then
Letra = primeraLetra
cod_letra = Asc(primeraLetra)
LetraIzq = Chr(cod_LetraIzq)
cod_LetraIzq += 1
Else
cod_letra += 1
Letra = Chr(cod_letra)
End If
End If
Next
'Dibujar el border exterior grueso de la tabla.
Dim objRango As Excel.Range = .Range(primeraLetra + primerNumero.ToString, UltimaLetraIzq + UltimaLetra + (UltimoNumero - 1).ToString)
objRango.Select()
objRango.Columns.AutoFit()
objRango.Columns.BorderAround(1, Excel.XlBorderWeight.xlMedium)
End With
m_Excel.Cursor = Excel.XlMousePointer.xlDefault