jortega/client
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
f6898c4a9b
client/ClasesModulos/aExcel.vb

383 lines
16 KiB
VB.net
Raw Normal View History

Primera carga de Minds Cliente para el proyecto de blackrock
2019-07-05 13:43:55 -05:00
'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<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
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<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 = "@"
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("<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
End Class
Reference in New Issue Copy Permalink