'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