2019-07-05 13:43:55 -05:00
'Enero 2006
'clase que se utiliza para la exportacion de datos a excel
2023-02-22 07:21:57 -06:00
Imports System . Globalization
Imports System . IO
2019-07-05 13:43:55 -05:00
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
2023-02-22 07:21:57 -06:00
2019-07-05 13:43:55 -05:00
''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<EFBFBD> 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
2023-02-22 07:21:57 -06:00
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
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'Se obtiene el numero de registros a exportar
Count = Tbl . Rows . Count
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'Se establen las propiedades de barra de progreso
frmBarra . pbrAvance . Maximum = Count
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'titulo de la hoja
ws . Name = " MINDS "
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'Periodo
'ws.Cells(1, 1) = "Periodo :" & " " & Classcom.ObtenFecha(clsVaribles.Finicio.Date, "dd/mmm/yy") & " - " & Classcom.ObtenFecha(clsVaribles.Ffin.Date, "dd/mmm/yy") & " " & " Fecha Impresi<73> n : " & " " & Classcom.ObtenFecha(Now.ToShortDateString, "dd/mmm/yy")
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'Se pone la fecha en la primera fila
'ws.Cells(row, 1) = Titulo & " " & CStr(Now.ToShortDateString)
ws . Cells ( row , 1 ) = Titulo
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'hacemos un rango para ponerlo en negrita
r = CType ( ws . Cells ( row , 1 ) , Range )
r . Font . Bold = True
'r.Font.Size = 8
row += 2
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'se recuperan los encabezados del dataset
Dim H As Integer
For H = 0 To Tbl . Columns . Count - 1
2019-07-05 13:43:55 -05:00
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.
2023-02-22 07:21:57 -06:00
'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
2019-07-05 13:43:55 -05:00
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 ( " <EFBFBD> Desea cancelar la exportaci<63> n?" , " Minds " , MessageBoxButtons . YesNo , MessageBoxIcon . Question ) = DialogResult . Yes Then
Exit Function
Else
frmBarra . pbExportCancel = False '--<2D> - 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<63> n " & ex . Message , " Minds " , MessageBoxButtons . OK , MessageBoxIcon . Information )
End Try
End Function
2023-02-22 07:21:57 -06:00
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
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'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<73> 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 = "@"
2019-07-05 13:43:55 -05:00
End If
2023-02-22 07:21:57 -06:00
''Fin de identificar la columna.
'ws.Columns(cell).autoFit()
'ws.Cells.HorizontalAlignment = "xlCenteR"
cell += 1
2019-07-05 13:43:55 -05:00
Next
2023-02-22 07:21:57 -06:00
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 ( " <EFBFBD> Desea cancelar la exportaci<63> n?" , " Minds " , MessageBoxButtons . YesNo , MessageBoxIcon . Question ) = DialogResult . Yes Then
Exit Function
Else
frmBarra . pbExportCancel = False '--<2D> - 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<63> 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<67> 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 )
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
excelApp . Sheets ( 1 ) . Name = " MINDS "
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
excelApp . Sheets ( 1 ) . Range ( " A1:AB1 " ) . Font . Bold = True
excelApp . Sheets ( 1 ) . Range ( " A1:AB1 " ) . BorderAround ( ColorIndex : = 0 , Weight : = XlBorderWeight . xlThick )
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
excelApp . Application . CutCopyMode = False
excelApp . Workbooks . Application . CutCopyMode = False
excelApp . Sheets ( 1 ) . Application . CutCopyMode = False
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
Dim objRango As Microsoft . Office . Interop . Excel . Range = excelApp . Sheets ( 1 ) . Range ( " A1:A " & trows )
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
'excelApp.Sheets(1).Range("B1:B" & tcols).ClearContents
2019-07-05 13:43:55 -05:00
2023-02-22 07:21:57 -06:00
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<EFBFBD> lisis " )
Else
Export2 ( Tbl , ws , Tbl . TableName )
End If
ConWs += 1
Next
MessageBox . Show ( " Exportaci<EFBFBD> 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
2019-07-05 13:43:55 -05:00
End Class