383 lines
16 KiB
VB.net
383 lines
16 KiB
VB.net
'Enero 2006
|
|
'clase que se utiliza para la exportacion de datos a excel
|
|
Imports Excel 'Aplicacion de excel
|
|
Imports Microsoft.Office
|
|
Public Class aExcel
|
|
Public Count As Integer 'Se utiliza para la barra de progreso
|
|
Dim frmBarra As ExcProgreso = New ExcProgreso 'Se instancia el form de la barra de progreso
|
|
Public Titulo As String = ""
|
|
Public excelApp As Interop.Excel.Application
|
|
|
|
Public Function ExportDataset(ByVal Ds As System.Data.DataSet)
|
|
'funcion que envia a excel una tabla de un dataset
|
|
Dim workBook As Interop.Excel.Workbook
|
|
Dim ConWs As Integer = 1
|
|
Try
|
|
'instanciamos la applicacion de excel
|
|
|
|
''System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("en-US")
|
|
System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("es-MX")
|
|
excelApp = New Interop.Excel.Application
|
|
'Creamos una hoja en el libro predeterminado
|
|
workBook = excelApp.Workbooks.Add(Interop.Excel.XlWBATemplate.xlWBATWorksheet)
|
|
Catch ex As Exception
|
|
'se utiliza la version 10 de excel o XP
|
|
MessageBox.Show("aExcel; ExportDataset: " & ex.Message, "MINDS", MessageBoxButtons.OK, MessageBoxIcon.Error)
|
|
End Try
|
|
'Declaramos una varible tipo hoja de trabajo
|
|
Dim ws As Interop.Excel.Worksheet
|
|
ws = CType(workBook.Worksheets(ConWs), Interop.Excel.Worksheet)
|
|
|
|
Dim Tbl As System.Data.DataTable
|
|
For Each Tbl In Ds.Tables
|
|
'recorre todas las tablas que contega el dataset, con esto determinanos cuantas hojas en excel
|
|
If ConWs > 1 Then
|
|
ws = CType(workBook.Worksheets.Add(, ws), Interop.Excel.Worksheet)
|
|
End If
|
|
'Llama a la funcion que exporta los datos
|
|
Export(Tbl, ws)
|
|
ConWs += 1
|
|
Next
|
|
MessageBox.Show("Exportación completa", "MINDS", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
|
frmBarra.Close() 'Cerramos el form de la barra de pregreso
|
|
'mostramos excel con la exportacion
|
|
excelApp.Sheets(1).Select()
|
|
excelApp.Sheets(1).Columns.AutoFit()
|
|
excelApp.Visible = True
|
|
''Selecciono la primera celda
|
|
ws.Cells(1, 1).select()
|
|
'workBook.Close() 'Cierra el libro
|
|
'excelApp.Quit() 'Sale de la aplicacion
|
|
''System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("es-MX")
|
|
''Auditoria
|
|
Dim ClassUtils As New ClassMyUtils
|
|
Dim sTextoAud As String
|
|
sTextoAud = "Exporta a Excel " & Titulo
|
|
ClassUtils.RT_Auditoria(clsVaribles.varUsuario, 118, 1, sTextoAud)
|
|
''Fin de auditoria
|
|
|
|
End Function
|
|
|
|
Private Function Export(ByVal Tbl As System.Data.DataTable, ByVal ws As Interop.Excel.Worksheet)
|
|
'Funcion que hace la exportacion de datos (COPIA)
|
|
Dim r As Excel.Range
|
|
Dim c As Excel.Chart
|
|
Dim row As Integer = 1
|
|
Dim cell As Integer = 1
|
|
'Dim Classcom As New clsComplejo
|
|
|
|
'Se obtiene el numero de registros a exportar
|
|
Count = Tbl.Rows.Count
|
|
|
|
'Se establen las propiedades de barra de progreso
|
|
frmBarra.pbrAvance.Maximum = Count
|
|
|
|
'titulo de la hoja
|
|
ws.Name = "MINDS"
|
|
|
|
'Periodo
|
|
'ws.Cells(1, 1) = "Periodo :" & " " & Classcom.ObtenFecha(clsVaribles.Finicio.Date, "dd/mmm/yy") & " - " & Classcom.ObtenFecha(clsVaribles.Ffin.Date, "dd/mmm/yy") & " " & " Fecha Impresión : " & " " & Classcom.ObtenFecha(Now.ToShortDateString, "dd/mmm/yy")
|
|
|
|
|
|
'Se pone la fecha en la primera fila
|
|
'ws.Cells(row, 1) = Titulo & " " & CStr(Now.ToShortDateString)
|
|
ws.Cells(row, 1) = Titulo
|
|
|
|
'hacemos un rango para ponerlo en negrita
|
|
r = CType(ws.Cells(row, 1), Range)
|
|
r.Font.Bold = True
|
|
'r.Font.Size = 8
|
|
row += 2
|
|
|
|
'se recuperan los encabezados del dataset
|
|
Dim H As Integer
|
|
For H = 0 To Tbl.Columns.Count - 1
|
|
ws.Cells(row, cell) = Tbl.Columns(H).Caption()
|
|
''Identifica si la columna es de tipo string. Si si es entonces formatea toda la columna a tipo String. (Esto para que las columnas de texto, no las maneje como numeros. Ejemplo: numero de cuenta)
|
|
If Tbl.Columns(H).DataType.ToString.ToUpper = "SYSTEM.STRING" Then
|
|
Dim cLetra As Char
|
|
Dim sLetra As String
|
|
''Obtiene la letra de la columna.
|
|
Dim iColExc As Integer
|
|
iColExc = 65 + H
|
|
Select Case iColExc
|
|
Case 65 To 90
|
|
cLetra = Chr(iColExc)
|
|
sLetra = cLetra.ToString
|
|
Case 91 To 116
|
|
cLetra = Chr(iColExc - 26)
|
|
sLetra = "A" & cLetra.ToString
|
|
Case 117 To 142
|
|
cLetra = Chr(iColExc - 26 * 2)
|
|
sLetra = "B" & cLetra.ToString
|
|
Case 143 To 168
|
|
cLetra = Chr(iColExc - 26 * 3)
|
|
sLetra = "C" & cLetra.ToString
|
|
Case 169 To 194
|
|
cLetra = Chr(iColExc - 26 * 4)
|
|
sLetra = "D" & cLetra.ToString
|
|
End Select
|
|
ws.Columns(sLetra & ":" & sLetra).Select() ''Quiere obtener F:F
|
|
ws.Columns(sLetra & ":" & sLetra).NumberFormat = "@"
|
|
''ws.Cells.NumberFormat = "@"
|
|
End If
|
|
''Fin de identificar la columna.
|
|
'ws.Columns(cell).autoFit()
|
|
'ws.Cells.HorizontalAlignment = "xlCenteR"
|
|
cell += 1
|
|
Next
|
|
|
|
For H = 1 To cell - 1
|
|
r = CType(ws.Cells(row, H), Range)
|
|
r.Font.Bold = True
|
|
'r.Font.Size = 8
|
|
r.Cells.BorderAround()
|
|
'r.HorizontalAlignment = "xlCenteR"
|
|
Next H
|
|
|
|
row += 1
|
|
cell = 1
|
|
|
|
'creando las filas
|
|
Dim dc As DataColumn
|
|
Dim Dr As DataRow
|
|
Dim x As Integer = 1 'para sacar el porcentaje
|
|
'se muestra el form de la bara de progreso
|
|
Try
|
|
frmBarra.pbExportCancel = False
|
|
frmBarra.Show()
|
|
|
|
'Copiando los datos
|
|
For Each Dr In Tbl.Rows
|
|
For H = 0 To Tbl.Columns.Count - 1
|
|
If IsDate(Dr.Item(H)) = True And Dr.Item(H).GetType().ToString.ToUpper = "SYSTEM.STRING" And (Dr.Item(H).ToString.Contains("/") = True Or Dr.Item(H).ToString.Contains("-") = True) Then
|
|
ws.Cells(row, cell) = DateTime.Parse(Dr.Item(H))
|
|
ElseIf Dr.Item(H).GetType().ToString.ToUpper = "SYSTEM.TIMESPAN" Then
|
|
ws.Cells(row, cell) = Dr.Item(H).ToString
|
|
Else
|
|
ws.Cells(row, cell) = Dr.Item(H)
|
|
End If
|
|
|
|
''LA Pc esta poniendo 02/01/1900 cuando la fecha es 01/01/1900, el codigo siguiente intenta remediar lo anterior.
|
|
If Left(Dr.Item(H).ToString(), 10) = "01/01/1900" Then
|
|
ws.Cells(row, cell) = "01/01/1900"
|
|
End If
|
|
|
|
'ws.Columns(cell).autoFit()
|
|
'ws.Cells.Font.Size = 8
|
|
cell += 1
|
|
Next
|
|
cell = 1
|
|
row += 1
|
|
'se va incrementando los cuadritos de la barra
|
|
frmBarra.pbrAvance.Value += 1
|
|
'Se saca el porcentaje
|
|
frmBarra.Text = "Exportando a Excel: " & CInt((x * 100) / Count) & " %"
|
|
x += 1
|
|
If (row Mod 100) = 0 Then
|
|
System.Windows.Forms.Application.DoEvents()
|
|
If frmBarra.pbExportCancel Then
|
|
If MessageBox.Show("¿Desea cancelar la exportación?", "Minds", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then
|
|
Exit Function
|
|
Else
|
|
frmBarra.pbExportCancel = False '--Ç- Se le agrega para continuar sin la cancelas
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
' row += 1 'la quite 3 enero 2006
|
|
Catch ex As Exception
|
|
MessageBox.Show("Hubo un problema en la exportación " & ex.Message, "Minds", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
|
End Try
|
|
End Function
|
|
|
|
Public Sub ExcelExport(ByVal Ds As System.Data.DataSet, ByVal lstitulo As String)
|
|
Try
|
|
Dim m_Excel As New Microsoft.Office.Interop.Excel.Application
|
|
Dim clCmpTipo As clsComplejo
|
|
|
|
Dim CategoryName As String ' Variable para controlar la ruptura por nombre de categoria
|
|
Dim apath As String
|
|
Dim filename As String
|
|
Dim aName As String
|
|
'' Creamos un objeto WorkBook
|
|
Dim objLibroExcel As Microsoft.Office.Interop.Excel.Workbook
|
|
|
|
'' Creamos un objeto WorkSheet
|
|
Dim objHojaExcel As Microsoft.Office.Interop.Excel.Worksheet
|
|
|
|
Dim sql As String
|
|
'sql = "spExportaExcel " & "'" & _tipo & "','" & _Nombre & "','" & _KYC_estatus & "','" & _estatuscte & "','" & clsvariables.VarPerfil & "','" & clsvariables.varIdFuncionario & "'"
|
|
|
|
clCmpTipo = New clsComplejo
|
|
'clCmpTipo.fdtDataSetTabla(sql)
|
|
clCmpTipo.ds = Ds
|
|
If clCmpTipo.ds.Tables.Count = 0 Then
|
|
' Me.GrdBusqueda.SetDataBinding(clCmp.ds, "Tabla") 'Llena el grid
|
|
|
|
MsgBox("Se ha realizado la búsqueda y no hay registros para mostrar. Revise su perfil, posiblemente no tenga acceso a ellos", MsgBoxStyle.Information)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
'' Iniciamos una instancia a excel
|
|
m_Excel = New Microsoft.Office.Interop.Excel.Application
|
|
m_Excel.Visible = True
|
|
|
|
'' Creamos una variable para gualdar la cultura actual
|
|
Dim OldCultureInfo As System.Globalization.CultureInfo = _
|
|
System.Threading.Thread.CurrentThread.CurrentCulture
|
|
|
|
'Crear una cultura standard (en-US) inglés estados unidos
|
|
System.Threading.Thread.CurrentThread.CurrentCulture = _
|
|
New System.Globalization.CultureInfo("en-US")
|
|
|
|
'' Creamos una instancia del Workbooks de excel
|
|
'' Creamos una instancia de la primera hoja de trabajo de excel
|
|
objLibroExcel = m_Excel.Workbooks.Add()
|
|
objHojaExcel = objLibroExcel.Worksheets(1)
|
|
objHojaExcel.Visible = Microsoft.Office.Interop.Excel.XlSheetVisibility.xlSheetVisible
|
|
|
|
'' Hacemos esta hoja la visible en pantalla
|
|
'' (como seleccionamos la primera esto no es necesario
|
|
'' si seleccionamos una diferente a la primera si lo
|
|
'' necesitariamos).
|
|
objHojaExcel.Activate()
|
|
|
|
aName = _
|
|
System.Reflection.Assembly.GetExecutingAssembly. _
|
|
GetModules()(0).FullyQualifiedName
|
|
|
|
apath = System.IO.Path.GetDirectoryName(aName)
|
|
filename = apath & "\logo1.jpg"
|
|
|
|
'Dim xlSheet1 As Excel.Worksheet
|
|
Dim xlRange As Microsoft.Office.Interop.Excel.Range
|
|
|
|
Dim ms As New System.IO.MemoryStream
|
|
Dim oIMage As Image = Image.FromFile(filename)
|
|
oIMage.Save(ms, oIMage.RawFormat)
|
|
Dim arrImage() As Byte = ms.GetBuffer
|
|
Dim integralLogo As Bitmap = CType(Image.FromStream(ms), Bitmap)
|
|
'integralLogo.Size = (100, 200)
|
|
Clipboard.SetDataObject(integralLogo)
|
|
xlRange = objHojaExcel.Range(objHojaExcel.Cells(1, 1), objHojaExcel.Cells(1, 1))
|
|
xlRange.Select()
|
|
objHojaExcel.Paste()
|
|
|
|
Dim nCol As Integer
|
|
Dim iI As Integer
|
|
Dim nameCol As String
|
|
|
|
nCol = clCmpTipo.ds.Tables(0).Columns.Count
|
|
|
|
'' Crear el encabezado de nuestro informe
|
|
objHojaExcel.Range("A1:" & Chr(nCol + 65) & "1").Merge()
|
|
objHojaExcel.Range("A1:" & Chr(nCol + 65) & "1").Value = lstitulo
|
|
objHojaExcel.Range("A1:" & Chr(nCol + 65) & "1").Font.Bold = True
|
|
objHojaExcel.Range("A1:" & Chr(nCol + 65) & "1").Font.Size = 15
|
|
objHojaExcel.Range("A1:" & Chr(nCol + 65) & "1").HorizontalAlignment = -4108
|
|
|
|
|
|
'' Crear el subencabezado de nuestro informe
|
|
objHojaExcel.Range("A2:g2").Merge()
|
|
objHojaExcel.Range("A2:g2").Value = ""
|
|
objHojaExcel.Range("A2:g2").Font.Italic = True
|
|
objHojaExcel.Range("A2:g2").Font.Size = 13
|
|
|
|
|
|
'contando el numero de columnas
|
|
Dim liContAlf As Integer = 65
|
|
Dim objCelda As Microsoft.Office.Interop.Excel.Range
|
|
'llenar el checked
|
|
For iI = 0 To nCol - 1
|
|
'recuperndo el nombre de la columna
|
|
nameCol = clCmpTipo.ds.Tables(0).Columns.Item(iI).Caption
|
|
objCelda = objHojaExcel.Range(Chr(liContAlf) & "4", Type.Missing)
|
|
objCelda.Value = nameCol
|
|
objCelda.EntireColumn.AutoFit()
|
|
liContAlf = liContAlf + 1
|
|
'LstColumnas.Items.Add(nameCol)
|
|
Next
|
|
|
|
|
|
Dim i As Integer = 6
|
|
Dim j As Integer = 6
|
|
Dim H As Integer
|
|
CategoryName = ""
|
|
|
|
|
|
|
|
For H = 0 To clCmpTipo.ds.Tables(0).Rows.Count - 1
|
|
|
|
'' Asignar los valores de los registros a las celdas
|
|
liContAlf = 65
|
|
For iI = 0 To nCol - 1
|
|
If IsDBNull(clCmpTipo.ds.Tables(0).Rows(H).Item(iI)) Then
|
|
objCelda = objHojaExcel.Range(Chr(liContAlf) & i, Type.Missing)
|
|
objCelda.Value = ""
|
|
|
|
Else
|
|
|
|
objHojaExcel.Cells(i, Chr(liContAlf)) = clCmpTipo.ds.Tables(0).Rows(H).Item(iI)
|
|
objCelda = objHojaExcel.Range(Chr(liContAlf) & i, Type.Missing)
|
|
If IsNumeric(clCmpTipo.ds.Tables(0).Rows(H).Item(iI)) Then
|
|
objCelda.Value = String.Format("{0:G}", clCmpTipo.ds.Tables(0).Rows(H).Item(iI))
|
|
objCelda.NumberFormat = "0"
|
|
ElseIf IsDate(clCmpTipo.ds.Tables(0).Rows(H).Item(iI)) Then
|
|
objCelda.Value = String.Format("{0:d}", clCmpTipo.ds.Tables(0).Rows(H).Item(iI))
|
|
Else
|
|
objCelda.Value = " " & clCmpTipo.ds.Tables(0).Rows(H).Item(iI).ToString
|
|
End If
|
|
'Debug.Print(clCmpTipo.ds.Tables(0).Rows(H).Item(iI))
|
|
'objHojaExcel.Cells(i, Chr(liContAlf)) = clCmpTipo.ds.Tables(0).Rows(H).Item(iI)
|
|
'objCelda = objHojaExcel.Range(Chr(liContAlf) & i, Type.Missing)
|
|
'objCelda.Value = clCmpTipo.ds.Tables(0).Rows(H).Item(iI)
|
|
|
|
End If
|
|
liContAlf = liContAlf + 1
|
|
'LstColumnas.Items.Add(nameCol)
|
|
Next
|
|
i += 1
|
|
Next
|
|
|
|
|
|
i += 1
|
|
|
|
'' Seleccionar todo el bloque desde A1 hasta D #de filas
|
|
Dim objRango As Microsoft.Office.Interop.Excel.Range = objHojaExcel.Range("A4:" & Chr(nCol + 65) & (i - 1).ToString)
|
|
|
|
'' Selecionado todo el rango especificado
|
|
objRango.Select()
|
|
|
|
'' Ajustamos el ancho de las columnas al ancho máximo del
|
|
'' contenido de sus celdas
|
|
objRango.Columns.AutoFit()
|
|
|
|
'' Asignar filtro por columna
|
|
objRango.AutoFilter(1, , VisibleDropDown:=True)
|
|
|
|
'' Asignar un formato automatico
|
|
objRango.AutoFormat(18, Alignment:=False)
|
|
'' Seleccionamos el total general del reporte y asignamos
|
|
'' font a negrita e italica
|
|
objRango = objHojaExcel.Range("A" & i.ToString & ":z" & i.ToString)
|
|
objRango.Select()
|
|
objRango.Font.Bold = True
|
|
objRango.Font.Italic = True
|
|
|
|
'' Crear un total general
|
|
objHojaExcel.Cells(i, 1) = "Total de Registros "
|
|
objHojaExcel.Cells(i, 3) = "=count(A6:a" & (i - 1).ToString & ")"
|
|
|
|
objHojaExcel = Nothing
|
|
objLibroExcel = Nothing
|
|
|
|
Catch ex As Exception
|
|
MessageBox.Show("Problemas al exportar " & ex.Message, "Minds", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
|
End Try
|
|
End Sub
|
|
|
|
|
|
End Class
|