'REFERENCIA A MICROSOFT EXCEL 12.0
'EL NUMERO 12.0 HACE REFERENCIA A MS
OFFICE 2007
'EL NUMERO 11.0 HARIA REFERENCIA A MS
OFFICE 2003
Imports Microsoft.OFFICE.INTEROP
'METODO PARA CREAR EL REPORTE EN
MICROSOFT EXCEL
Public Sub
EXPORTARDATOSEXCEL(ByVal
DATAGRIDVIEW1 As DataGridView, ByVal TITULO As String)
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()
'ENCABEZADO.
.RANGE("A1:L1").MERGE()
.RANGE("A1:L1").VALUE = "TITULO."
.RANGE("A1:L1").FONT.BOLD = True
.RANGE("A1:L1").FONT.SIZE = 16
'TEXTO DESPUES DEL ENCABEZADO.
.RANGE("A2:L2").MERGE()
.RANGE("A2:L2").VALUE = TITULO
.RANGE("A2:L2").FONT.BOLD = True
.RANGE("A2:L2").FONT.SIZE = 10
'ESPACIO.
.RANGE("A3:L3").MERGE()
.RANGE("A3:L3").VALUE = ""
.RANGE("A3:L3").FONT.BOLD = True
.RANGE("A3:L3").FONT.SIZE = 10
'ESTILO A TITULOS DE LA TABLA.
.RANGE("A4:P4").FONT.BOLD = True
'ESTABLECER TIPO DE LETRA AL RANGO
DETERMINADO.
.RANGE("A1:P100").FONT.NAME = "TAHOMA"
'LOS DATOS SE REGISTRAN A PARTIR DE LA
COLUMNA A, FILA 4.
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
SEPDEC As String = Application.CurrentCulture.NumberFormat.NumberDecimalSeparator
Dim SEPMIL As String = Application.CurrentCulture.NumberFormat.NumberGroupSeparator
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
DATAGRIDVIEW1.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
'ESTABLECE UN FORMATO A LOS NUMEROS POR
DEFAULT.
'OBJCELDA.ENTIRECOLUMN.NUMBERFORMAT =
C.DEFAULTCELLSTYLE.FORMAT
If C.ValueType Is GetType(Decimal) OrElse C.ValueType Is GetType(Double) Then
OBJCELDA.ENTIRECOLUMN.NUMBERFORMAT = "#" + SEPMIL + "0" + SEPDEC + "00"
End If
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
For Each REG As DataGridViewRow In DATAGRIDVIEW1.Rows
LETRAIZQ = ""
COD_LETRAIZQ = Asc(PRIMERALETRA) -
1
LETRA = PRIMERALETRA
COD_LETRA = Asc(PRIMERALETRA) - 1
For Each C As DataGridViewColumn In DATAGRIDVIEW1.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)
'ESTABLECE LAS
PROPIEDADES DE LOS DATOS DEL DATAGRIDVIEW POR DEFAULT.
'.CELLS(I, STRCOLUMNA)
= IIF(ISDBNULL(REG.(C.DATAPROPERTYNAME)), C.DEFAULTCELLSTYLE.NULLVALUE, REG(C.DATAPROPERTYNAME))
'.RANGE(STRCOLUMNA +
I, STRCOLUMNA + I).IN()
End If
Next
Dim OBJRANGOREG As EXCEL.RANGE = .RANGE(PRIMERALETRA +
I.ToString, STRCOLUMNA + I.ToString)
OBJRANGOREG.ROWS.BORDERAROUND()
OBJRANGOREG.SELECT()
I += 1
Next
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 DATAGRIDVIEW1.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
End Sub
'''BOTON:
Private Sub BTNEXCEL_CLICK(ByVal SENDER As System.Object, ByVal E As System.EventArgs) Handles BTNEXCEL.CLICK
Try
'INTENTAR
GENERAR EL DOCUMENTO.
'SE
ADJUNTA UN TEXTO DEBAJO DEL ENCABEZADO CON LA FECHA ACTUAL DEL SISTEMA.
EXPORTARDATOSEXCEL(GRID, "REPORTE PARA LA FECHA: " + Now.Date())
Catch EX As Exception
'SI
EL INTENTO ES FALLIDO, MOSTRAR MSGBOX.
MessageBox.Show("NO SE PUEDE
GENERAR EL DOCUMENTO EXCEL.", "ERROR", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
No hay comentarios:
Publicar un comentario