'Enero 2006 'clase que se utiliza para la exportacion de datos a excel Imports System.Globalization Imports System.IO 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 Private Function Export2(ByVal Tbl As System.Data.DataTable, ByVal ws As Interop.Excel.Worksheet, name As String) '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 frmBarra.pbrAvance.Value = 0 'titulo de la hoja ws.Name = name '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 Public Function ExportCSV(ByVal Ds As System.Data.DataSet) Dim fileroot As String Dim wrFile As StreamWriter Dim enc As String Dim tcols As Integer = 0 Dim trows As Integer = 0 Dim ext As String Dim name As String Dim root As String Try Do fileroot = generarNombreArchivo() Loop While File.Exists(fileroot) If Ds.Tables(0).Rows.Count > 0 Then wrFile = New StreamWriter(fileroot) Dim ls As String = CultureInfo.CurrentCulture.TextInfo.ListSeparator enc = String.Format("Registro en Lista{0}NIC{0}CLIENTE{0}Nombre Figura{0}Tipo Figura{0}Nombre Coincidencia{0}Alias Coincidencia{0}Observaciones Coincidencia{0}Porcentaje Nombre{0}Porcentaje Observaciones{0}Organismo{0}Estatus{0}Fecha Coincidencia{0}Fecha Cambio{0}Comentario{0}CLIENTE RFC{0}LISTA RFC{0}ID LISTA{0}id_status{0}Id_Organismo{0}figura{0}IDCliente{0}Id_Figura{0}ORGANISMO QUIEN ES QUIEN{0}CURP{0}ESTATUS QUIEN ES QUIEN{0}TIPO DE OFICIO{0}FECHA OFICIO", ls) wrFile.WriteLine(enc) trows = Ds.Tables(0).Rows.Count + 1 tcols = Ds.Tables(0).Columns.Count + 1 For Each r As DataRow In Ds.Tables(0).Rows For Each c As Object In r.ItemArray wrFile.Write(c.ToString.Replace(",", "*") & ls) 'wrFile.Write(c.ToString & ls) Next wrFile.WriteLine() Next wrFile.Flush() wrFile.Close() Dim dataFile As New FileInfo(fileroot) Dim fileExcel As String ext = dataFile.Extension name = dataFile.Name root = dataFile.DirectoryName fileExcel = root & "\" & name.Replace(ext, "") & ".xlsx" 'FileSystem.Rename(fileroot, fileExcel) 'Process.Start(fileExcel) 'Process.Start(fileroot) 'excelApp = New Interop.Excel.Application 'excelApp.GetOpenFilename() 'excelApp.Visible = True 'Process.Start(fileroot) excelApp = New Interop.Excel.Application excelApp.Workbooks.Open(fileroot) excelApp.Sheets(1).Name = "MINDS" excelApp.Sheets(1).Range("A1:AB1").Font.Bold = True excelApp.Sheets(1).Range("A1:AB1").BorderAround(ColorIndex:=0, Weight:=XlBorderWeight.xlThick) excelApp.Application.CutCopyMode = False excelApp.Workbooks.Application.CutCopyMode = False excelApp.Sheets(1).Application.CutCopyMode = False Dim objRango As Microsoft.Office.Interop.Excel.Range = excelApp.Sheets(1).Range("A1:A" & trows) 'excelApp.Sheets(1).Range("B1:B" & tcols).ClearContents excelApp.Sheets(1).Range("A1:A" & trows).TextToColumns(Destination:=objRango, DataType:=XlTextParsingType.xlDelimited, Other:=True, OtherChar:="|" ) excelApp.Sheets(1).Columns.AutoFit() 'excelApp.Sheets(1).Range("A1:A" & tcols).ClearContents 'excelApp.Sheets(1).Range("A1").TextToColumns(Destination:=objRango, ' DataType:=XlTextParsingType.xlDelimited, ' TextQualifier:=XlTextQualifier.xlTextQualifierDoubleQuote, ' ConsecutiveDelimiter:=False, ' Tab:=False, ' Semicolon:=False, ' Comma:=False, ' Space:=False, ' Other:=True, ' OtherChar:="|", ' FieldInfo:="Valor", ' TrailingMinusNumbers:=True) 'excelApp.Sheets(1).range("A1:" & ) 'excelApp.Sheets(1).Range("A1") 'r.Font.Bold = True 'r.Cells.BorderAround() 'excelApp.Sheets(1).Select() 'excelApp.Sheets(1).Columns.AutoFit() 'Dim objHojaExcel As Microsoft.Office.Interop.Excel.Worksheet excelApp.Visible = True 'excelApp.Sheets(1).Active End If 'ClassUtils.RT_Auditoria(clsVaribles.varUsuario, 118, 1, sTextoAud) Catch ex As Exception If excelApp IsNot Nothing Then excelApp.Workbooks().Close() excelApp.Quit() excelApp = Nothing End If MsgBox(ex.Message) End Try End Function Private Function generarNombreArchivo() Return Path.GetTempPath() & Now.Second & Now.Millisecond & ".csv" End Function Public Function ExportExcel(ByVal Ds As System.Data.DataSet) Dim fileroot As String Dim wrFile As StreamWriter Dim enc As String Dim tcols As Integer = 0 Dim trows As Integer = 0 Dim contR As Integer = 1 Dim contC As Integer = 1 Dim ext As String Dim name As String Dim root As String Dim excelApp As New Excel.Application Dim workbook As Interop.Excel.Workbook Dim sheet As Excel.Worksheet Try Do fileroot = generarNombreArchivo() Loop While File.Exists(fileroot) If Ds.Tables(0).Rows.Count > 0 Then excelApp = New Interop.Excel.Application workbook = excelApp.Workbooks.Add(Interop.Excel.XlWBATemplate.xlWBATWorksheet) sheet = workbook.Worksheets(1) For i As Integer = 1 To Ds.Tables(0).Columns.Count - 1 sheet.Cells(contR, i).value = Ds.Tables(0).Columns.Item(i - 1).ColumnName Next contR = contR + 1 contC = 1 For Each r As DataRow In Ds.Tables(0).Rows For Each c As Object In r.ItemArray 'wrFile.Write(c.ToString & ls) 'wrFile.Write(c.ToString & ls) sheet.Cells(contR, contC).value = c.ToString contC = contC + 1 Next contR = contR + 1 contC = 1 Next excelApp.Sheets(1).Columns.AutoFit() excelApp.Visible = True 'sheet.Activate() 'excelApp.Sheets(1).Active End If 'ClassUtils.RT_Auditoria(clsVaribles.varUsuario, 118, 1, sTextoAud) Catch ex As Exception If excelApp IsNot Nothing Then excelApp.Workbooks().Close() excelApp.Quit() excelApp = Nothing End If MsgBox(ex.Message) End Try End Function Public Function ExportToExcel(ByVal Ds As System.Data.DataSet) Dim tcols As Integer = 0 Dim trows As Integer = 0 Dim contR As Integer = 0 Dim contC As Integer = 0 Dim pbMax As Integer = 0 Dim excelApp As New Excel.Application Dim workbook As Interop.Excel.Workbook Dim sheet As Excel.Worksheet Try If Ds.Tables(0).Rows.Count > 0 Then frmBarra.Text = "Exportando a Excel: 0 %" frmBarra.Show() excelApp = New Interop.Excel.Application workbook = excelApp.Workbooks.Add(Interop.Excel.XlWBATemplate.xlWBATWorksheet) sheet = workbook.Worksheets(1) sheet.Name = "MINDS" trows = Ds.Tables(0).Rows.Count + 1 pbMax = trows + (trows * 0.1) frmBarra.pbrAvance.Maximum = pbMax System.Windows.Forms.Application.DoEvents() Dim data(trows, Ds.Tables(0).Columns.Count) As String For i As Integer = 0 To Ds.Tables(0).Columns.Count - 1 data(contR, i) = Ds.Tables(0).Columns.Item(i).ColumnName Next frmBarra.pbrAvance.Value += 1 contR = contR + 1 contC = 0 For Each r As DataRow In Ds.Tables(0).Rows For Each c As Object In r.ItemArray data(contR, contC) = c.ToString contC = contC + 1 Next contR = contR + 1 contC = 0 frmBarra.Text = "Exportando a Excel: " & CInt((contR * 100) / pbMax) & " %" frmBarra.pbrAvance.Value += 1 Next System.Windows.Forms.Application.DoEvents() workbook.Worksheets(1).Range("A1:AB" & trows) = data excelApp.Sheets(1).Range("A1:AB1").Font.Bold = True excelApp.Sheets(1).Range("A1:AB1").BorderAround(ColorIndex:=0, Weight:=XlBorderWeight.xlThin) excelApp.Sheets(1).Columns.AutoFit() excelApp.Sheets(1).Activate excelApp.Visible = True frmBarra.Text = "Exportando a Excel: 100 %" frmBarra.pbrAvance.Value = frmBarra.pbrAvance.Maximum frmBarra.Close() End If Dim ClassUtils As New ClassMyUtils Dim sTextoAud As String sTextoAud = "Exporta a Excel Coincidencia Listas" ClassUtils.RT_Auditoria(clsVaribles.varUsuario, 118, 1, sTextoAud) Catch ex As Exception frmBarra.Close() If excelApp IsNot Nothing Then excelApp.Workbooks().Close() excelApp.Quit() excelApp = Nothing End If MsgBox(ex.Message) End Try End Function Public Function ExportTo2Woook(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("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; ExportTo2: " & 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 If Tbl.TableName = "ReporteJ14_1" Then Export2(Tbl, ws, "Resumen") ElseIf Tbl.TableName = "ReporteJ14_2" Then Export2(Tbl, ws, "Análisis") Else Export2(Tbl, ws, Tbl.TableName) End If 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 End Class