Private Sub salir_btn_Click(sender As Object, e As EventArgs) Handles salir_btn.Click
Dim hoy As Date = Now
If hoy.DayOfWeek = DayOfWeek.Wednesday Then
Try
'AÑADIMOS EL LIBRO AL EXCEL Y LA HOJA AL LIBRO
exLibro = exApp.Workbooks.Add
exHoja = exApp.Sheets(1)
'CONTAMOS COLUMNAS Y FILAS
Dim NCol As Integer = DataGridView1.ColumnCount
Dim NRow As Integer = DataGridView1.RowCount
'RECORREMOS TODAS LAS FILAS Y POR CADA COLUMNA ESCRIBIMOS
For i As Integer = 1 To NCol
exHoja.Cells.Item(1, i) = DataGridView1.Columns(i - 1).Name.ToString
Next
For Fila As Integer = 0 To NRow - 1
For Col As Integer = 0 To NCol - 1
exHoja.Cells.Item(Fila + 2, Col + 1) = DataGridView1.Rows(Fila).Cells(Col).Value
Next
Next
Dim M_Izq As Integer = 63
Dim M_Der As Integer = 43
Dim M_Sup As Integer = 35
Dim M_Inf As Integer = 40
'ORIENTACIÓN DE LA HOJA
With exHoja.PageSetup
.Orientation = Excel.XlPageOrientation.xlPortrait
'CONFIGURACIÓN DE MÁRGENES
.LeftMargin = M_Izq
.RightMargin = M_Der
.TopMargin = M_Sup
.BottomMargin = M_Inf
End With
'TÍTULO EN NEGRITA, ALINEADO AL CENTRO DE LAS CELDAS Y COLOR
Dim anio As Int16 = Now.Year
Dim objRango As Excel.Range = exHoja.Range(exHoja.Cells(1, 1), exHoja.Cells(exHoja.UsedRange.Rows.Count, exHoja.UsedRange.Columns.Count))
Dim contador As Integer = exHoja.Rows.Count
exHoja.PageSetup.PrintTitleRows = exHoja.Rows(1).Address 'PONEMOS LA FILA DE ENCABEZADO EN TODAS LAS HOJAS IMPRESAS
exHoja.PageSetup.PaperSize = Excel.XlPaperSize.xlPaperA4 'TAMAÑO DE PAPEL A4
exHoja.Name = "Histórico tensión " & anio
exHoja.Rows.Item(1).Font.Bold = 1 'NEGRITA
exHoja.Rows.Item(1).Font.ColorIndex = 49 'COLOR DEL ENCABEZADO
exHoja.Rows.Item(1).HorizontalAlignment = 3 'ALINEADO DEL ENCABEZADO
objRango.HorizontalAlignment = 3 'ALINEADO DE LAS COLUMNAS
exHoja.Range("A1").Value = " FECHA " exHoja.Range("B1").Value = " SISTÓLICA " exHoja.Range("C1").Value = " DIASTÓLICA " exHoja.Range("D1").Value = " PULSACIONES " exHoja.Range("E1").Value = " SATURACIÓN " exHoja.Range("A1:E1").Cells.Interior.Color = Color.Cyan
objRango.Borders.LineStyle = 1 'BORDES DE LA HOJA
exHoja.Rows.Font.Size = 12 ' TAMAÑO DE LA FUENTE
exHoja.Rows.Font.Name = "Adobe Garamond Pro Bold" 'TIPO DE FUENTE
exHoja.Columns.AutoFit() 'AJUSTE DE LAS COLUMNAS
exHoja.Range("A2:A367").Font.ColorIndex = 5 'COLOR DE LA FUENTE DE LA COLUMNA DE FECHAS exHoja.Range("A2:A367").NumberFormat = "dd/mm/yyyy"
'DAMOS FORMATO CONDICIONAL DE LAS CELDAS
'FORMATO A COLUMNA DE FECHA
For Fila As Integer = 2 To NRow + 1
For Col As Integer = 2 To NCol
Dim FC As String = Chr(64 + Col) & Fila
exHoja.Range(FC).Select()
exHoja.Range(FC).Font.ColorIndex = 1
exHoja.Range(FC).Font.Bold = True
Next
Next
'FORMATO A COLUMNA SISTÓLICA
For Fila As Integer = 2 To NRow + 1
For Col As Integer = 2 To NCol - 3
Dim FC As String = Chr(64 + Col) & Fila
exHoja.Range(FC).Select()
If exHoja.Range(FC).Value >= 15 Or exHoja.Range(FC).Value <= 11 Then
exHoja.Range(FC).Font.ColorIndex = 3
exHoja.Range(FC).Font.Bold = True
End If
Next
Next
'FORMATO A COLUMNA DIASTÓLICA
For Fila As Integer = 2 To NRow + 1
For Col As Integer = 3 To NCol - 2
Dim FC As String = Chr(64 + Col) & Fila
exHoja.Range(FC).Select()
If exHoja.Range(FC).Value <= 5 Or exHoja.Range(FC).Value >= 8 Then
exHoja.Range(FC).Font.ColorIndex = 3
exHoja.Range(FC).Font.Bold = True
End If
Next
Next
'FORMATO A COLUMNA PULSACIONES
For Fila As Integer = 2 To NRow + 1
For Col As Integer = 4 To NCol - 1
Dim FC As String = Chr(64 + Col) & Fila
exHoja.Range(FC).Select()
If exHoja.Range(FC).Value <= 59 Or exHoja.Range(FC).Value >= 80 Then
exHoja.Range(FC).Font.ColorIndex = 3
exHoja.Range(FC).Font.Bold = True
End If
Next
Next
'FORMATO A COLUMNA SATURACIÓN
For Fila As Integer = 2 To NRow + 1
For Col As Integer = 5 To NCol
Dim FC As String = Chr(64 + Col) & Fila
exHoja.Range(FC).Select()
If exHoja.Range(FC).Value <= 90 Then
exHoja.Range(FC).Font.ColorIndex = 3
exHoja.Range(FC).Font.Bold = True
End If
Next
Next
exHoja.Range("E1").End(Excel.XlDirection.xlDown).Select()
'ESCRIBIMOS LAS MEDIAS DE CADA COLUMNA
Dim ultimafila As Long
ultimafila = exHoja.Range("A370").End(Excel.XlDirection.xlUp).Row ultimafila += 2
exHoja.Cells(ultimafila, 1).Select()
exHoja.Cells(ultimafila, 1).Value = "MEDIAS: "
exHoja.Cells(ultimafila, 1).Font.ColorIndex = 32
exHoja.Cells(ultimafila, 1).Interior.Color = Color.Chartreuse
exHoja.Cells(ultimafila, 1).HorizontalAlignment = 3
exHoja.Cells(ultimafila, 2).FormulaLocal = "=REDONDEAR(PROMEDIO(B2:B" & ultimafila - 2 & ");2)"
exHoja.Cells(ultimafila, 2).HorizontalAlignment = 3
exHoja.Cells(ultimafila, 3).FormulaLocal = "=REDONDEAR(PROMEDIO(C2:C" & ultimafila - 2 & ");2)"
exHoja.Cells(ultimafila, 3).HorizontalAlignment = 3
exHoja.Cells(ultimafila, 4).FormulaLocal = "=REDONDEAR(PROMEDIO(D2:D" & ultimafila - 2 & ");0)"
exHoja.Cells(ultimafila, 4).HorizontalAlignment = 3
exHoja.Cells(ultimafila, 5).FormulaLocal = "=REDONDEAR(PROMEDIO(E2:E" & ultimafila - 2 & ");0)"
exHoja.Cells(ultimafila, 5).HorizontalAlignment = 3
exHoja.Range("E1").End(Excel.XlDirection.xlDown).Select()
'COMPROBAMOS SI EXISTE EL FICHERO Y LO SOBRESCRIBIMOS SI ES ASÍ
'MOSTRAMOS EL MESSAGE BOX
Dim archivo_anio As String = "D:\Documentos\Escaneados\Informe_medico_infarto_2019\Tensión\Historico tension " & anio & ".xlsx"
Dim Message As String = "¿QUIERES GUARDAR LA HOJA EXCEL DEL AÑO?"
Dim Caption As String = "OPCIÓN DE GUARDAR"
Dim Buttons As MessageBoxButtons = MessageBoxButtons.YesNoCancel
Dim Result As DialogResult
Result = MessageBox.Show(Message, Caption, Buttons)
ultimacelda = exHoja.Range("A1").End(Excel.XlDirection.xlDown).Value
exApp.ActiveWindow.WindowState = Excel.XlWindowState.xlMaximized
'RESULTADO DE LA OPCIÓN AFIRMATIVA
If Result = System.Windows.Forms.DialogResult.No Then
If System.IO.File.Exists(archivo) = True And ultimacelda <> Now Then
'SI EL ARCHIVO EXISTE LO BORRAMOS Y GUARDAMOS EL NUEVO
System.IO.File.Delete(archivo)
exLibro.SaveAs(archivo)
ElseIf ultimacelda = Format(Now, "Short Date") Then
Dim P As System.Diagnostics.Process
Try
For Each P In System.Diagnostics.Process.GetProcesses
If P.ProcessName.ToUpper Like "*EXCEL*" Then
P.Kill()
End If
Next
Catch
End Try
GC.WaitForPendingFinalizers()
GC.Collect()
Else
'SI NO EXISTE LO GUARDAMOS
exLibro.SaveAs(archivo)
End If
Dim Message1 As String = "FICHERO GUARDADO CON ÉXITO."
Dim Caption1 As String = "GUARDADO"
Dim Buttons1 As MessageBoxButtons = MessageBoxButtons.OK
Dim Result1 As DialogResult
Result1 = MessageBox.Show(Message1, Caption1, Buttons1)
'GUARDAMOS EL ARCHIVO TAMBIEN COMO PDF
Dim nombre As String = exHoja.Name
Dim ruta As String = "D:\Documentos\Escaneados\Informe_medico_infarto_2019\Tensión\"
exLibro.ExportAsFixedFormat(Excel.XlFixedFormatType.xlTypePDF, ruta & nombre & ".pdf", Excel.XlFixedFormatQuality.xlQualityStandard, True, True, 1, 30, False)
ElseIf Result = System.Windows.Forms.DialogResult.Yes Then
If System.IO.File.Exists(archivo_anio) = True Then
'SI EL ARCHIVO EXISTE LO BORRAMOS Y GUARDAMOS EL NUEVO
System.IO.File.Delete(archivo_anio)
exLibro.SaveAs(archivo_anio)
Else
'SI NO EXISTE LO GUARDAMOS
exLibro.SaveAs(archivo_anio)
End If
Dim Message1 As String = "FICHERO GUARDADO CON ÉXITO."
Dim Caption1 As String = "GUARDADO"
Dim Buttons1 As MessageBoxButtons = MessageBoxButtons.OK
Dim Result1 As DialogResult
Result1 = MessageBox.Show(Message1, Caption1, Buttons1)
End If
'APLICACIÓN VISIBLE
exApp.Application.Visible = True
exHoja = Nothing
exLibro = Nothing
exApp = Nothing
Catch ex As Exception
MessageBox.Show(ex.Message, "ERROR AL EXPORTAR A EXCEL", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
' LIMPIAMOS TODOS LOS PROCESOS DE EXCEL ABIERTOS DE LA MEMORIA
Try
For Each P In System.Diagnostics.Process.GetProcesses
If P.ProcessName.ToUpper Like "*EXCEL*" Then
P.Kill()
End If
Next
Catch
End Try
GC.WaitForPendingFinalizers()
GC.Collect()
End If
Me.Close()
Form3.Close()
End Sub
