Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

ESTADISTICAS Mundiales del CORONAVIRUS – Web Scraping Raspado Web #1007 Parte 1

Estadisticas Mundiales Coronavirus Raspado Web

Libro Excel Estadísticas Mundiales Covid-19 – Parte 1

La macro de Excel contenida en el libro de Excel que se muestra en este post, permite hacer WEB SCRAPING o RASPADO WEB a una página de estadísticas mundiales, obteniendo los datos actualizados de los casos de CORONAVIRUS o COVID-19 en todo el mundo, en otras palabras con una macro de Excel se obtendrán datos de la WEB en forma automática.

Los link a cada una de las partes del ejemplo como realizar con macro de Excel VBA un web scraping o raspado web , se muestran a continuación:

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007/parte1

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007-parte2

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007-parte3/

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-modificar-ribbon-1008-parte4//

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-insertar-graficos-1009-parte5

Opera Excel como los mejores haz click acá, si quieres aprender sobre Excel en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet, te lo recomiendo no te arrepentirás.

Suscribe a nuestro canal de You Tube, mira el playlist con  vídeos relacionados donde podrás ver la macro en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.

Estadísticas on line Coronavirus en Excel

Es un libro de Excel que a través de web scraping o raspado web obtiene las estadísticas mundiales del coronavirus, entre otros datos obtiene la cantidad de casos a nivel mundial, casos de covid-19 por país, muertes producidas, personas recuperadas y muchos datos más.

Los datos se actualizan constantemente en dicha web por ende cada vez que se presiona el icono para conectar a la web se obtienen datos actualizados a cada instante,el libro «Estadísticas de Coronavirus Covid-19 en Excel«, permite guardar los datos en Access, pudiendo consultar los registros de días u horas pasadas, los registros que se obtienen son a nivel mundial detallado por cada país.

Para entender el ejemplo en forma sencilla se debe descargar el archivo comprimido que contiene tres archivos en el mismo directorio como consejo, pero no importa la carpeta donde de guarden ya que se debe configurar desde botón Setup, una sola vez por lo menos dichos valores se mantendrán hasta que sean cambiados nuevamente, se debe establecer la dirección del directorio donde se encuentra la base de datos Access y donde se guardarán los archivos exportados de Excel, PDF y Word, es decir el archivo con la macro de Excel, la base de datos de Access donde se guardarán los registros y el archivo PDF con la ayuda.


Quizás también interese leer:

Conectar Excel con Excel Consulta SQL Obtener Todos Datos Base del Mismo Libro
Conectar Excel con Excel Consulta SQL Copia Datos de Una Hoja a Otra de Distinto Libro
Conectar Excel con Excel Consulta SQL Rango Fechas con Datos Mismo Libro

Funciones del Libro Estadísticas Covid-19 en Excel

La principal función es mostrar en un Libro de Excel las estadísticas a nivel mundial de coronavirus covid-19,  para ello el libro contiene muchas macros de Excel que fueron publicadas en https://macrosenexcel.com y aquí son recopiladas en un solo libro, pero la principal macro que se quiere mostrar es la que enseña como hacer un Web Scraping o Raspado Web,  se muestra como con macros de Excel – VBA se pueden obtener datos de una página web y exponerlos en Excel para poder manipularlos.

Seguidamente se enumera todas la macros que se pueden observar en el Libro Estadísticas Mundiales de Covid 19.

  • Web Scraping – Raspado Web: Obtiene datos desde la Web y son mostrados en Excel
  • Modificación de Ribbon: Se agregan menú y botones personalizados
  •  Conexión de Excel con Access: Se guardan los datos de Excel en Access y luego se pueden recuperar para mostrarlos en Excel nuevamente
  • Exportar datos a PDB
  • Exportar datos a Excel
  • Exportar datos a Word, escribir y manejo de Word desde Excel
  • Exportar gráficos a Word
  • Exportar tablas a Word
  • Ordenar datos por varios criterios
  • Quitar Filtros
  • Limpiar Controles
  • Configurar Hoja
  • Vista Previa Hoja Excel
  • Imprimir en Excel
  • Configuración de parámetros del programa
  • Abrir PDF de libro de ayuda.
  • Crear Link a Google Maps o cualquier otra Web
  • Búsqueda de datos mientras se escribe o en tiempo real
  • Uso de SQL en Excel para Conectarse con Access e ingresar y consultar datos
  • Progress Bar o Barra de Progress

Todo lo mencionado se realiza con macros de Excel – VBA siendo el listado algo enumerativo, pero se pueden observar muchas macros más como manejo de formularios de controles ActiveX, etc, etc..

Descripción de los Menú del Libro de Excel con Estadísticas Covid-19

El sistema contiene una pestaña personalizada que se denomina Estadísticas Coronavirus – Covid 19, presionando en dicha pestaña se muestran una serie de iconos que están relacionados con macros personalizadas que permite realizar diferentes funciones, las cuales son descriptas al pasar el mouse y dejarlo un segundo sobre el icono del que se requiere obtener ayuda sobre la función que realiza, los botones o iconos de la pestaña personalizada son los siguientes:

ACTUALIZAR
Presionando este menú permite descargar datos actuales de la página de estadísticas mundiales, la cual muestra el día y hora de actualización de dichas estadísticas, realiza un web scraping o raspado web obteniendo los datos necesarios de la página a la cual se conecta.

ORDENAR
Presionando este menú permite ordenar los datos por cuatro criterios distintos y por el campo que se desee ya sea en forma ascendente o descendente.

LIMPIAR
Presionando este menú permite limpiar los controles Textbox para proceder a realizar una nueva búsqueda, también se logra el mismo resultado borrando con el teclado de a un carácter o marcando el texto con el mouse y presionando suprimir.

GUARDAR ACCESS
Presionando este menú guarda los datos del cuadro con las estadísticas en la base de datos de Access, este libro se conecta con una base de datos Access que se acompaña con la macro, si no se desea guardar los datos igual funciona al poder actualizar y tener los datos al día, la diferencia es que no se podrá guardar un registro de los datos anteriores.

SETUP HOJA
Presionando este menú permite configurar la hoja para impresión, básicamente configura el encabezado de la página.

VISTA PREVIA
Presionando este menú permite realizar una vista previa de la hoja de Excel.

IMPRIMIR HOJA
Presionando este menú permite imprimir la hoja de Excel que se está visualizando, se debe tener presente que el libro de Excel.

EXPORTAR APDF
Permite exportar o guardar en PDF la hoja de Excel, guardándose el fichero en el directorio determinado a tal fin en el Formulario de Configuración o Setup.

EXPORTAR A EXCEL
Permite exportar a Excel toda la hoja de Excel genera un archivo con el mismo nombre que la macro en el directorio determinado a tal fin en el Formulario de Configuración o Setup.

EXPORTAR A WORD
Permite exportar a Word la grilla donde que se encuentra en el libro, agrega texto pudiendo manejar Word desde Excel, también exporta desde Excel gráficos y tabla a Word.

SETUP
Permite configurar la dirección del directorio donde se encuentran el archivo de Access con la Base de Datos de índices y las carpetas para Guardar Archivos en PDF, Excel y Word.

AYUDA
Permite mostrar un archivo PDF con la ayuda de este aplicativo

Como se Opera el Sistema y Obtener de la Web las Estadísticas Mundiales del Coronavirus Detallado por País

Presionando el botón actualizar la macro de Excel se conectará y realizará un raspado web a una web de estadísticas mundiales y actualizará todas los ratios, pegando los datos actualizados en la hoja de Excel.

En las filas 6 a 19 se muestran los totales a nivel mundial, a la derecha se muestran cuatro gráficos uno con un mapa mundial , que mostrará la cantidad dependiendo del espacio del país en el gráfico y tres gráficos más para mostrar en forma gráfica los totales.

En el combobox Seleccione datos, se puede seleccionar, porque columna se desea buscar, en caso de que seleccione una columna distinta al ítem “país” se mostrará otro combobox para que se ingrese un rango de números.

A medida que se escribe caracteres en el Textbox destinado a ingresar los datos de búsqueda, se irán mostrando las coincidencias en el cuadro o grilla correspondiente que se encuentra desde la fila 21 en adelante.

En la fila 6 a 21 columnas F a I se encuentran una serie de links de interés con el caso de Coronavirus Covid 19, entre otros enlaces a la Organización Mundial de la Salud y Ministerios de Salud de distintos países.

En el combobox que se encuentra a la derecha se muestra la fecha de la cual se están mostrando los datos en la grilla de Excel, si se guardaron datos en Access desplegando el combobox se podrá seleccionar la fecha y la macro buscará los datos en Access y los mostrará en Excel en la grilla destinada a tal fin, actualizándose en forma automática los gráficos con los datos mostrados.

A la derecha arriba de los gráficos se encuentra el link a nuestro canal de YouTube, donde se podrá observar vídeo explicativo, de este como de cientos de ejemplos publicados, asimismo se encuentra al lado link la dirección WEB de nuestra página https://macrosenexcel.com donde se puede descargar este y muchos ejemplos más en forma gratuita.

Descarga del Libro Excel con código del ejemplo Como Hacer Scraping Web o Raspado Web

Antes de finalizar el post se encuentra el link de descarga del Libro de Excel de ejemplo que se usa en el vídeo relacionado que recomiendo ver para su mejor y más fácil entendimiento, se descarga en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, aporta a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.

Código que va en el módulo Actualizar

Sub ObtieneEstadistica()
Dim MyRespu As String, MyTable As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

‘Elimina, crea hoja, asigna nombre
For Each she In Worksheets
mys = she.Name
If she.Name = «Actualizar» Then she.Delete
Next
ActiveWorkbook.Sheets.Add AFTER:=Worksheets(Worksheets.Count)
ActiveSheet.Name = «Actualizar»

UserForm1.ProgressBar1.Value = 20
UserForm1.Label1.Caption = «20 %»
DoEvents

Set a = Sheets(«Actualizar»)
a.Cells.Delete
Set b = Sheets(«Estadisticas»)

UserForm1.ProgressBar1.Value = 30
UserForm1.Label1.Caption = «30 %»
DoEvents

Application.DisplayAlerts = False

With CreateObject(«MSXML2.XMLHTTP»)
.Open «GET», «https://www.worldometers.info/coronavirus/», False
.send
ActiveWindow.Application.SendKeys «(~)»
MyRespu = StrConv(.responseBody, vbUnicode)
End With

MyRespu = Mid$(MyRespu, InStr(1, MyRespu, «<!DOCTYPE «))

With CreateObject(«htmlFile»)
.Write MyRespu

Set MyTable = .getElementsByTagName(«table»)(0)
End With

UserForm1.ProgressBar1.Value = 40
UserForm1.Label1.Caption = «40 %»
DoEvents

Sheets(«Actualizar»).Select
WriteTable MyTable

UserForm1.ProgressBar1.Value = 50
UserForm1.Label1.Caption = «50 %»
DoEvents

‘Copia y ordena los datos en la hoja Estadistica
If b.FilterMode = True Then b.ShowAllData
ufb = b.Range(«A» & Rows.Count).End(xlUp).Row
If ufb <= 21 Then ufb = 22
b.Range(«A22:I» & ufb).Clear

b.Range(«F2:I2»).Merge
b.Range(«F2:I2»).HorizontalAlignment = xlCenter

b.Range(«A6») = «TOTAL CASOS CORONAVIRUS – COVID 19»
b.Range(«A7») = «TOTAL CASOS»
b.Range(«A8») = «TOTAL MUERTOS»
b.Range(«A9») = «TOTAL RECUPERADOS»

b.Range(«A11») = «TOTAL CASOS ACTIVOS»
b.Range(«A12») = «TOTAL INFECTADOS»
b.Range(«A13») = «TOTAL CONDICION LEVE»
b.Range(«A14») = «TOTAL CONDICION CRITICA»

b.Range(«A16») = «TOTAL CASOS CERRADOS»
b.Range(«A17») = «TOTAL CASOS TUVIERON RESULTADO»
b.Range(«A18») = «TOTAL RECUPERADOS»
b.Range(«A19») = «TOTAL MUERTOS»

UserForm1.ProgressBar1.Value = 60
UserForm1.Label1.Caption = «60 %»
DoEvents

a.ranga(«J1») = MyRespu

‘Ultima actualización
Principio = «>Last updated: «
Final = «<a href=»»/coronavirus/coronavirus-cases/»»> Case Graphs»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
Lastupdate = Replace(dato, Principio, «»)
Lastupdate = Replace(Lastupdate, Chr(34), «»)
Lastupdate = Replace(Lastupdate, «</div>», «»)
Lastupdate = Replace(Lastupdate, «<div style=margin-top:20px; text-align:center; font-size:14px>», «»)
Lastupdate = Replace(Lastupdate, Chr(10), «») ‘elimina tabulaciones

‘Total de Casos
Principio = «<span style=»»color:#aaa»»>»
Final = «<a href=»»#countries»»>view by country</a>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCasos = Replace((Replace(dato, Principio, «»)), «,», «»)
Posi3 = InStr(TotalCasos, » «)
TotalCasos = Left(TotalCasos, Posi3)
TotalCasos = Replace(TotalCasos, «,», «»)

‘Total de Muertos
Principio = «<h1>Deaths:</h1>»
Final = «<h1>Recovered:</h1>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalMuertos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalMuertos = Replace(TotalMuertos, Chr(34), «») ‘elimina comillas
TotalMuertos = Replace(TotalMuertos, «<div class=maincounter-number>», «»)
TotalMuertos = Replace(TotalMuertos, «<span>», «») ‘elimina texto
TotalMuertos = Replace(TotalMuertos, «</span>», «»)
Posi3 = InStr(TotalMuertos, «</div>»)
TotalMuertos = Left(TotalMuertos, Posi3 – 1)
TotalMuertos = Replace(TotalMuertos, Chr(32), «») ‘elimina espacio blanco
TotalMuertos = Replace(TotalMuertos, Chr(10), «») ‘elimina tabulaciones

‘Total de Recuperados
Principio = «<h1>Recovered:</h1>»
Final = «<div style=»»margin-top:50px;»»>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalRecuperados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalRecuperados = Replace(TotalRecuperados, Chr(34), «») ‘elimina comillas
TotalRecuperados = Replace(TotalRecuperados, «<div class=maincounter-number style=color:#8ACA2B >», «»)
TotalRecuperados = Replace(TotalRecuperados, «<span>», «») ‘elimina texto
TotalRecuperados = Replace(TotalRecuperados, «</span>», «»)
Posi3 = InStr(TotalRecuperados, «</div>»)
TotalRecuperados = Left(TotalRecuperados, Posi3 – 1)
TotalRecuperados = Replace(TotalRecuperados, Chr(32), «») ‘elimina espacio blanco
TotalRecuperados = Replace(TotalRecuperados, Chr(10), «») ‘elimina tabulaciones

UserForm1.ProgressBar1.Value = 70
UserForm1.Label1.Caption = «70 %»
DoEvents

‘Total de Infectados
Principio = «<div class=»»panel-body»» style=»»text-align:center; height:200px;»»>»
Final = «<div style=»»font-size:13.5px»»>Currently Infected Patients»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalInfectados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalInfectados = Replace(TotalInfectados, Chr(34), «») ‘elimina comillas
TotalInfectados = Replace(TotalInfectados, «<div class=panel_flip>», «»)
TotalInfectados = Replace(TotalInfectados, «<div class=panel_front style=width:100%;height:100%;>», «»)
TotalInfectados = Replace(TotalInfectados, «<div class=number-table-main>», «»)
Posi3 = InStr(TotalInfectados, «</div>»)
TotalInfectados = Left(TotalInfectados, Posi3 – 1)
TotalInfectados = Replace(TotalInfectados, Chr(32), «») ‘elimina espacio blanco
TotalInfectados = Replace(TotalInfectados, Chr(10), «») ‘elimina tabulaciones

‘Total de Condicion Leve
Principio = «Currently Infected Patients</div>»
Final = «<div style=»»font-size:13px»»>in Mild Condition»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalLeves = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalLeves = Replace(TotalLeves, Chr(34), «») ‘elimina comillas
TotalLeves = Replace(TotalLeves, «<div style=padding-top:20px;position:relative;text-align:center; >», «»)
TotalLeves = Replace(TotalLeves, «<div style=float:left; text-align:center>», «»)
TotalLeves = Replace(TotalLeves, «<span class=number-table style=color:#8080FF>», «»)
Posi3 = InStr(TotalLeves, «</span>»)
TotalLeves = Left(TotalLeves, Posi3 – 1)
TotalLeves = Replace(TotalLeves, Chr(32), «») ‘elimina espacio blanco
TotalLeves = Replace(TotalLeves, Chr(10), «») ‘elimina tabulaciones

‘Total de Condición Critica
Principio = «in Mild Condition</div>»
Final = «<div style=»»font-size:13px»»>Serious or Critical»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCriticos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCriticos = Replace(TotalCriticos, Chr(34), «») ‘elimina comillas
TotalCriticos = Replace(TotalCriticos, «<br>», «»)
TotalCriticos = Replace(TotalCriticos, «</div>», «»)
TotalCriticos = Replace(TotalCriticos, «<div style=float:right; text-align:center><span class=number-table style=color:red >», «»)
Posi3 = InStr(TotalCriticos, «</span>»)
TotalCriticos = Left(TotalCriticos, Posi3 – 1)
TotalCriticos = Replace(TotalCriticos, Chr(32), «») ‘elimina espacio blanco
TotalCriticos = Replace(TotalCriticos, Chr(10), «») ‘elimina tabulaciones

‘Total de Casos Cerrados
Principio = «Closed Cases</span>»
Final = «<div style=»»font-size:13.5px»»>Cases which had an outcome:»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerrado = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerrado = Replace(TotalCerrado, Chr(34), «») ‘elimina comillas
TotalCerrado = Replace(TotalCerrado, «</div>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel-body style=text-align:center;height:200px;>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel_flip>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel_front style=width:100%;height:100%;>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=number-table-main>», «»)
Posi3 = InStr(TotalCerrado, «</div>»)
TotalCerrado = Left(TotalCerrado, Posi3 – 1)
TotalCerrado = Replace(TotalCerrado, Chr(32), «») ‘elimina espacio blanco
TotalCerrado = Replace(TotalCerrado, Chr(10), «») ‘elimina tabulaciones

‘Total de Recuperados
Principio = «Cases which had an outcome:</div>»
Final = «<div style=»»font-size:13px»»>Recovered»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerradoRecuperados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(34), «») ‘elimina comillas
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<div style=padding-top:20px >», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<div style=float:left; text-align:center>», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<span class=number-table style=color:#8ACA2B>», «»)
Posi3 = InStr(TotalCerradoRecuperados, «</span>»)
TotalCerradoRecuperados = Left(TotalCerradoRecuperados, Posi3 – 1)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(32), «») ‘elimina espacio blanco
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(10), «») ‘elimina tabulaciones

‘Total de Muertos
Principio = «Recovered / Discharged</div>»
Final = «<div style=»»font-size:13px»»>Deaths»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerradoMuertos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(34), «») ‘elimina comillas
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «<br>», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «</div>», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «<div style=float:right; text-align:center><span class=number-table>», «»)
Posi3 = InStr(TotalCerradoMuertos, «</span>»)
TotalCerradoMuertos = Left(TotalCerradoMuertos, Posi3 – 1)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(32), «») ‘elimina espacio blanco
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(10), «») ‘elimina tabulaciones

UserForm1.ProgressBar1.Value = 80
UserForm1.Label1.Caption = «80 %»
DoEvents

b.Range(«F2») = Lastupdate
Application.EnableEvents = False
b.ComboBox2 = Lastupdate

b.Range(«D7») = TotalCasos
b.Range(«D8») = TotalMuertos
b.Range(«D9») = TotalRecuperados

b.Range(«D12») = TotalInfectados
b.Range(«D13») = TotalLeves
b.Range(«D14») = TotalCriticos

b.Range(«D17») = TotalCerrado
b.Range(«D18») = TotalCerradoRecuperados
b.Range(«D19») = TotalCerradoMuertos

uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
a.Range(«A2:I» & uf).Copy
b.Range(«A22»).PasteSpecial xlPasteValues

b.Range(«A21») = «País»
b.Range(«B21») = «Casos»
b.Range(«C21») = «Nuevos Casos»
b.Range(«D21») = «Muertes»
b.Range(«E21») = «Nuevas Muertes»
b.Range(«F21») = «Recuperados»
b.Range(«G21») = «Casos Activos»
b.Range(«H21») = «Casos Criticos»
b.Range(«I21») = «Casos/1M Pob»

uf = b.Range(«A» & Rows.Count).End(xlUp).Row – 1
For x = 3 To 9
For j = 22 To uf
If b.Cells(j, x) = Empty Then b.Cells(j, x) = 0
Next j
Next x

UserForm1.ProgressBar1.Value = 90
UserForm1.Label1.Caption = «90 %»
DoEvents

‘uf = b.Range(«A» & Rows.Count).End(xlUp).Row
‘For x = 23 To uf Step 2
‘b.Range(«A» & x & «:I» & x).Interior.Color = 13082801 ‘morado claro 13082801 ‘5296274 verde claro
‘Next x
‘b.Range(«A» & uf & «:I» & uf).Font.Bold = True
Call Formato

Application.DisplayAlerts = False
Application.ScreenUpdating = False
‘MsgBox («Los datos se han importado con éxito » & b.Range(«E2»)), vbInformation, «AVISO»
a.Delete
b.Select
Range(«A1»).Select

UserForm1.ProgressBar1.Value = 100
UserForm1.Label1.Caption = «100 %»
DoEvents

Unload UserForm1
Application.StatusBar = Clear
‘Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Public Sub WriteTable(ByVal MyTable As Object, Optional ByVal StarR As Long = 1, Optional ByVal Ws As Worksheet)
Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
Dim Titulos As Object, Titulo As Object, CantCol As Long

If Ws Is Nothing Then Set Ws = ActiveSheet
R = StarR
With ActiveSheet
Set Titulos = MyTable.getElementsByTagName(«th»)
For Each Titulo In Titulos
CantCol = CantCol + 1
.Cells(StarR, CantCol) = Titulo.innerText
Next Titulo
StarR = StarR + 1
Set tBody = MyTable.getElementsByTagName(«tbody»)
For Each tSection In tBody ‘HTMLTableSection
Set tRow = tSection.getElementsByTagName(«tr») ‘HTMLTableRow
For Each tr In tRow
R = R + 1
Set tCell = tr.getElementsByTagName(«td»)
C = 1
For Each td In tCell ‘DispHTMLElementCollection
.Cells(R, C).Value = td.innerText ‘HTMLTableCell
C = C + 1
Next td
Next tr
Next tSection
End With
End Sub

Código que va en el módulo Herramientas

Sub Formato()
Set d = Sheets(«Estadisticas»)

d.Range(«A2:V4»).Interior.Color = 12611584 ‘celeste oscuro
d.Range(«E2:I4,B2:C4»).Font.Color = 12611584 ‘celeste oscuro
d.Range(«A2:A3,D3»).Font.Color = 16777215 ‘blanco
d.Range(«A1:V1»).Interior.Color = 0 ‘negro
d.Range(«A1:V1»).Font.Color = 16777215 ‘blanco
d.Range(«F6:I19»).Interior.Color = 16777215 ‘blanco
d.Range(«F6:I6»).Interior.Color = 13082801 ‘Morado claro

With d.Range(«A21:I21»)
.Interior.Color = 0 ‘negro
.Font.Color = 16777215 ‘blanco
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With

uf = d.Range(«A» & Rows.Count).End(xlUp).Row
If uf < 21 Then uf = 21

For x = 23 To uf Step 2
d.Range(«A» & x & «:I» & x).Interior.Color = 13082801 ‘morado claro 13082801 ‘5296274 verde claro
Next x

d.Range(«J:J»).Interior.Color = xlNone
d.Range(«J1:J» & uf).Interior.Color = 49407

d.Range(«B22:H» & uf & «,D7:D9,D12:D14,D17:D19»).NumberFormat = «#,##0»
d.Range(«I22:I» & uf & «,D7:D9,D12:D14,D17:D19»).NumberFormat = «#,##0.00»

d.Range(«A:A»).ColumnWidth = 17
d.Range(«B:B»).ColumnWidth = 10.71
d.Range(«C:C»).ColumnWidth = 12.14
d.Range(«D:D»).ColumnWidth = 12
d.Range(«E:E»).ColumnWidth = 14
d.Range(«F:F»).ColumnWidth = 11.86
d.Range(«G:G»).ColumnWidth = 12.43
d.Range(«H:H»).ColumnWidth = 12.57
d.Range(«I:I»).ColumnWidth = 12.43

With d.Range(«A21:I» & uf)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlNxlContinuousone
.Borders(xlInsideHorizontal).Weight = xlThin
.VerticalAlignment = xlCenter
End With

With d.Range(«A» & uf & «:I» & uf)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Font.Bold = True
End With

‘Link a google maps
uf = d.Range(«A» & Rows.Count).End(xlUp).Row – 1
For x = 22 To uf
d.Range(«I» & x) = d.Range(«I» & x) * 1 ‘multiplica por 1 para tranformar texto en número
d1 = «https://maps.google.es/maps?q=» & d.Range(«A» & x)
dt = d.Range(«A» & x)
d.Hyperlinks.Add Anchor:=d.Range(«A» & x), Address:=d1, TextToDisplay:=dt
Next x
End Sub

Sub Limpiar()
Set a = Sheets(«Estadisticas»)
a.Range(«C2:D3»).ClearContents
a.TextBox2.Visible = False
a.ComboBox1 = «País»
a.TextBox1 = Clear
End Sub

Sub GuardarPDF()
Set b = Sheets(«Estadisticas»)
uf = Range(«A» & Rows.Count).End(xlUp).Row
nompdf = b.Range(«A1″) & » » & Date
nompdf = Replace(nompdf, «\», «-«)
nompdf = Replace(nompdf, «/», «-«)
nompdf = Replace(nompdf, «:», «-«)
nompdf = Replace(nompdf, «*», «-«)
nompdf = Replace(nompdf, «?», «-«)
nompdf = Replace(nompdf, «»»», «-«)
nompdf = Replace(nompdf, «<«, «-«)
nompdf = Replace(nompdf, «>», «-«)
nompdf = Replace(nompdf, «|», «-«)
nompdf = Replace(nompdf, «(«, «»)
nompdf = Replace(nompdf, «)», «-«)

ruta = Sheets(«Parametros»).Range(«E2»)
rutapdf1 = ruta & «\» & nompdf & «.pdf»
b.Range(«A1:I» & uf).ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutapdf1, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox («El archivo se guardó con éxito»), vbInformation, «AVISO»
End Sub

Sub ExportaExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set b = Sheets(«Estadisticas»)
uf = Range(«A» & Rows.Count).End(xlUp).Row
nomexc = b.Range(«A1″) & » » & Date
nomexc = Replace(nomexc, «\», «-«)
nomexc = Replace(nomexc, «/», «-«)
nomexc = Replace(nomexc, «:», «-«)
nomexc = Replace(nomexc, «*», «-«)
nomexc = Replace(nomexc, «?», «-«)
nomexc = Replace(nomexc, «»»», «-«)
nomexc = Replace(nomexc, «<«, «-«)
nomexc = Replace(nomexc, «>», «-«)
nomexc = Replace(nomexc, «|», «-«)
nomexc = Replace(nomexc, «(«, «»)
nomexc = Replace(nomexc, «)», «-«)

ruta = Sheets(«Parametros»).Range(«D2»)
rutaexc1 = ruta & «\» & nomexc & «.xlsx»
nomarchi = nomexc & «.xlsx»

ActiveSheet.Copy
ActiveSheet.Shapes(«Combobox1»).Delete
ActiveSheet.Shapes(«Textbox1»).Delete
‘ActiveSheet.Columns(«A:H»).AutoFit

ActiveWorkbook.SaveAs Filename:=rutaexc1, FileFormat:=xlOpenXMLWorkbook
Workbooks(nomarchi).Close True

MsgBox («El archivo Excel se generó con éxito»), vbInformation, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub VistaPrevia()
On Error Resume Next
Application.Dialogs(xlDialogPrintPreview).Show
End Sub

Sub Imprime()
On Error Resume Next
ActiveSheet.PrintOut Copies:=2, Collate:=True, IgnorePrintAreas:=False
End Sub

Sub Ordenar()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set a = Sheets(«Estadisticas»)
‘Ordena datos de la base en forma descendente para cargar datos descendente en combobox
uf = a.Range(«C» & Rows.Count).End(xlUp).Row
R = «I14:I» & uf
r1 = «A14:I» & uf

‘sorts the data
a.Sort.SortFields.Clear
a.Sort.SortFields.Add Key:=Range(R), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With a.Sort
.SetRange Range(r1)
.header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Quitafiltro()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Set a = Sheets(«Estadisticas»)
If a.FilterMode = True Then a.ShowAllData
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Código que va en el módulo Insertar

Sub InsertaEstadisticasCovid19()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim cn As ADODB.Connection, rs As ADODB.Recordset
On Error Resume Next
Set a = Sheets(«Estadisticas»)
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
mybookindice = Sheets(«Parametros»).Range(«C2»)
cn.Open «Provider=Microsoft.ACE.OLEDB.12.0; » & «data source=» & mybookindice & «;»

‘Verifica si la fecha y hora que se intenta ingresar ya fue registrada
‘Sql = «SELECT Fecha, Pais, Casos, Nuevos_Casos, Muertes, Nuevas_Muertes, Recuperados, Casos_Activos, Casos_Criticos, Casos_1M_Pob FROM DB_COVID_19 WHERE Fecha = ‘» & a.ComboBox2 & «‘»
Sql = «SELECT Fecha FROM DB_COVID_19 WHERE Fecha = ‘» & a.ComboBox2 & «‘»
Set rs = cn.Execute(Sql)
myfecha = rs.fields(0)
Set rs = Nothing
If myfecha <> Empty Then MsgBox («Los datos ya existen en la base de datos»), vbCritical, «AVISO»: Exit Sub

‘Graba datos en base de datos
uf = a.Range(«A» & Rows.Count).End(xlUp).Row – 1
For x = 22 To uf
Sql = «INSERT INTO DB_COVID_19 (Fecha, Pais, Casos, Nuevos_Casos, Muertes, Nuevas_Muertes, Recuperados, Casos_Activos, Casos_Criticos, Casos_1M_Pob) VALUES (‘» & a.ComboBox2 & «‘, ‘» & a.Cells(x, «A») & «‘, » & a.Cells(x, «B») & «, » & a.Cells(x, «C») & «, » & a.Cells(x, «D») & «, » & a.Cells(x, «E») & «, » & a.Cells(x, «F») & «, » & a.Cells(x, «G») & «, » & a.Cells(x, «H») & «, ‘» & a.Cells(x, «I») & «‘)»
cn.Execute Sql
Next x

‘Application.EnableEvents = False ‘Anula el evento change del combbox al escribir en el
‘Carga combobox
a.ComboBox2.Clear
Sql = «SELECT DISTINCT Fecha FROM DB_COVID_19»
Set rs = cn.Execute(Sql)
Do While rs.EOF = False
a.ComboBox2.AddItem rs.fields(0)
rs.MoveNext
Loop
‘Application.EnableEvents = True

Set rs = Nothing
cn.Close
Set cn = Nothing

MsgBox («Las estadísticas se guardaron con éxito en la base de datos access»), vbInformation, «AVISO»
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Código que va en el módulo Menu


#If VBA7 And Win64 Then
‘Si es de 64 bits
Public Declare PtrSafe Function ShellExecute Lib «shell32.dll» Alias «ShellExecuteA» (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Function FindWindow Lib «user32» Alias «FindWindowA» (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function GetWindowLongPtr Lib «user32» Alias «GetWindowLongPtrA» (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib «user32» Alias «SetWindowLongPtrA» (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function DrawMenuBar Lib «user32» (ByVal hwnd As Long) As LongPtr
Public Declare PtrSafe Function RegOpenKeyA Lib «advapire32.dll» (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As LongPtr
Public Declare PtrSafe Function SetCursorPos Lib «user32» (ByVal x As LongPtr, ByVal y As LongPtr) As LongPtr
Public Declare PtrSafe Sub mouse_event Lib «user32» (ByVal dwFlags As LongPtr, ByVal dx As LongPtr, ByVal dy As LongPtr, ByVal cButtons As LongPtr, ByVal dwExtraInfo As LongPtr)
Public Declare PtrSafe Function SetWindowPos Lib «user32» (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As LongPtr, ByVal y As LongPtr, ByVal cx As LongPtr, ByVal cy As LongPtr, ByVal wFlags As LongPtr) As LongPtr
Public Declare PtrSafe Function SetForegroundWindow Lib «user32» (ByVal hwnd As LongPtr) As LongPtr
#Else
‘Si es de 32 bits
Public Declare Function ShellExecute Lib «shell32.dll» Alias «ShellExecuteA» (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function FindWindow Lib «USER32» Alias «FindWindowA» (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib «USER32» Alias «GetWindowLongA» (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib «USER32» Alias «SetWindowLongA» (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib «USER32» (ByVal hwnd As Long) As Long
Public Declare Function RegOpenKeyA Lib «advapire32.dll» (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function SetCursorPos Lib «USER32» (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib «USER32» (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Function SetWindowPos Lib «USER32» (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
PUBLIC Declare Function SetForegroundWindow Lib «user32» (ByVal hwnd As Long) As Long
#End If

Public llama

Sub macro11(control As IRibbonControl)
‘Menu Vista previa planilla
On Error Resume Next
Call VistaPrevia
End Sub
Sub macro12(control As IRibbonControl)
‘Menu imprime planilla
On Error Resume Next
Call Imprime
End Sub
Sub macro13(control As IRibbonControl)
‘Menu guarda en PDF
On Error Resume Next
Call GuardarPDF
End Sub
Sub macro14(control As IRibbonControl)
‘Menu exporta a Excel
On Error Resume Next
Call ExportaExcel
End Sub
Sub macro15(control As IRibbonControl)
‘Actualiza desde Explorer
On Error Resume Next
llama = 15
UserForm1.Show
End Sub
Sub macro16(control As IRibbonControl)
‘Guardar en Access
On Error Resume Next
Call InsertaEstadisticasCovid19
End Sub
Sub macro17(control As IRibbonControl)
‘Menu Ordena datos
On Error Resume Next
UserForm4.Show
End Sub
Sub macro18(control As IRibbonControl)
‘Menu Limpia textbox y combobox para realizar nueva busqueda
On Error Resume Next
Call Limpiar
End Sub

Sub macro22(control As IRibbonControl)
‘Menu Setup
On Error Resume Next
UserForm3.Show
End Sub
Sub macro23(control As IRibbonControl)
‘Menu ayuda
On Error Resume Next
ActiveWorkbook.FollowHyperlink ThisWorkbook.Path & «\» & «1007 Estadisticas Munciales Coronavirus Covid 19.pdf», , True
End Sub
Sub macro24(control As IRibbonControl)
‘Menu Actualiza y obtiene estadisticas de la web
On Error Resume Next
llama = 24
UserForm1.Show
End Sub
Sub macro25(control As IRibbonControl)
‘Menu Configurar Encabezado Hoja Excel
On Error Resume Next
UserForm2.Show
End Sub
Sub macro26(control As IRibbonControl)
‘Menu exporta a Word
On Error Resume Next
Call ExportaWord
End Sub
Sub macro27(control As IRibbonControl)
‘Menu quita filtro
On Error Resume Next
Call Quitafiltro
End Sub

Código que va en el módulo Word

Sub ExportaWord()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
‘Dim datos(0 To 1, 0 To 5) As String
On Error Resume Next
Set a = Sheets(«Estadisticas»)

‘Establecemos el nombre del fichero
nom = a.Range(«A1″) & » » & Date
If Len(nom) > 60 Then nom = Mid(nom, 1, 60)
Cad = Trim(nom)
Cad = Replace(Cad, «/», «_»)
Cad = Replace(Cad, «\», «_»)
Cad = Replace(Cad, «:», «_»)
Cad = Replace(Cad, «*», «_»)
Cad = Replace(Cad, «?», «_»)
Cad = Replace(Cad, Chr(34), «_») ‘reemplaza comilla por guion bajo
Cad = Replace(Cad, «<«, «_»)
Cad = Replace(Cad, «>», «_»)
Cad = Replace(Cad, «|», «_»)
Cad = Replace(Cad, «[«, «»)
Cad = Replace(Cad, «]», «»)
Cad = Replace(Cad, «(«, «»)
Cad = Replace(Cad, «)», «-«)
Cad = Replace(Cad, «|», «-«)
Cad = Replace(Cad, «»»», «-«)

nomarch = Cad & «.docx»
rutaescrito = Sheets(«Parametros»).Range(«F2») & «\» & nomarch ‘Dire carpeta guarda word y nombre archivo

Set objWord = CreateObject(«Word.Application»)
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Application.StatusBar = «Procesando, aguarde …»

Set wdDoc = objWord.Documents.Add
objWord.Selection.TypeText Text:=»INFORME ESTADISTICA MUNDIAL CORONAVIRUS – COVID 19″

‘Formato a párrafos en este caso solo el primer párrafo
objWord.ActiveDocument.Paragraphs(1).Range.Bold = True
objWord.ActiveDocument.Paragraphs(1).Alignment wdAlignParagraphCenter
objWord.ActiveDocument.Paragraphs(1).Range.Font.Underline = wdUnderlineSingle

objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»Seguidamente presentamos el panorama mundial del virus Covid 19 – Coronavirus:»

objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»[CUADRO1]»

‘Copia Grafico
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»Seguidamente se muestra en forma gráfica a nivel mundial los infectados por Covid 19 – Coronavirus:»
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»[GRA1]»
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»[GRA2]»
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»[GRA3]»
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=»[GRA4]»

‘Copia tabla
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
a.Range(«A21:I» & uf).Copy
ts = «[CUADRO1]»
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute findText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute findText:=ts
Wend

For x = 1 To ActiveSheet.ChartObjects.Count
ActiveSheet.ChartObjects(x).CopyPicture
xx = Selection.Name

ts = «[GRA» & x & «]»
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute findText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.Paste ‘ False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute findText:=ts
can = can + 1
Wend
Next x

‘Guarda el archivo con el nombre asignado
wdDoc.SaveAs Filename:=rutaescrito, FileFormat:=wdFormatXMLDocument
‘wdDoc.Close
objWord.Quit

MsgBox («Se exportaron con éxito los datos a Word»), vbInformation, «AVISO»

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Código que va en el userform1

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
Private Sub UserForm_Activate()
Select Case llama
Case Is = 15
‘Call ObtieneEstadisticasExplorer
Case Is = 24
Call ObtieneEstadistica
End Select
End Sub

Código que va en el userform2


Private Sub UserForm_Initialize()
Me.TextBox1 = «ANEXO A.3»
Me.TextBox2 = «ESTADISTICAS MUNDIALES»
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Set b = Sheets(«Estadisticas»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row + 1

‘Configura página entre ello las filas a repetir
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = «$13:$13»
.PrintArea = «$A$13:$H$» & uf – 1
.LeftMargin = Application.CentimetersToPoints(3)
.RightMargin = Application.CentimetersToPoints(1.5)
.TopMargin = Application.CentimetersToPoints(4)
.BottomMargin = Application.CentimetersToPoints(1.5)
.HeaderMargin = Application.CentimetersToPoints(2.5)
.FooterMargin = Application.CentimetersToPoints(0.5)
‘.Orientation = xlLandscape ‘apaisado
.Orientation = xlPortrait ‘vertical
.CenterHorizontally = True
.FitToPagesWide = 1
.FitToPagesTall = 10
‘.CenterHeader = «&»»Verdana,Negrita»»&9PLANILLA DE CALCULOS JUDICIALES&»»Verdana,Negrita»»&10» & Chr(10) & «&»»Verdana,Negrita»»Tribunal Superior de Justicia de Córdoba» ‘Esto es para cordoba
‘.CenterHeader = «&»»Verdana,Negrita»»&9PLANILLA DE CALCULOS JUDICIALES&»»Verdana,Negrita»»&10» ‘ & Chr(10) & «&»»Verdana,Negrita»»Tribunal Superior de Justicia de Córdoba» ‘Esto es para todos
‘.LeftHeader = «»
‘.CenterHeader = «»
‘.RightHeader = «»
Application.PrintCommunication = True
.LeftHeader = «&»»Verdana,Negrita»»&9» & Me.TextBox1 & «&»»Verdana,Negrita»»&10» ‘ & Chr(10) & «&»»Verdana,Negrita»»Tribunal Superior de Justicia de Córdoba» ‘Esto es para todos
.CenterHeader = «&»»Verdana,Negrita»»&9» & Me.TextBox2 & «&»»Verdana,Negrita»»&10» ‘ & Chr(10) & «&»»Verdana,Negrita»»Tribunal Superior de Justicia de Córdoba» ‘Esto es para todos
.RightHeader = «&»»Verdana,Negrita»»&9» & Me.TextBox3 & «&»»Verdana,Negrita»»&10» ‘ & Chr(10) & «&»»Verdana,Negrita»»Tribunal Superior de Justicia de Córdoba» ‘Esto es para todos

End With

End Sub

Código que va en el userform3

Private Sub CheckBox1_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If CheckBox1 = True Then
TextBox1 = ThisWorkbook.Path
TextBox2 = ThisWorkbook.Path
TextBox3 = ThisWorkbook.Path
TextBox4 = ThisWorkbook.Path
Else
TextBox1 = Clear
TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String
On Error Resume Next
ruta = ActiveWorkbook.Path
ChDir ruta
path1 = Application.GetOpenFilename(«Archivos Excel (*.accdb*), *.db*»)
If path1 = «» Then
MsgBox «No ha seleccionado directorio carpeta Macro, seleccione directorio .», , «AVISO»
Exit Sub
End If
TextBox1 = path1
Sheets(«Configuracion»).Cells(2, «A») = TextBox1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path2 As String
On Error Resume Next
path2 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path2 = «» Then
MsgBox «No ha seleccionado directorio carpeta PDF, seleccione directorio .», , «AVISO»
Exit Sub
End If
TextBox2 = path2
Sheets(«Configuracion»).Cells(2, «B») = TextBox2
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path3 As String
On Error Resume Next
path3 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path3 = «» Then
MsgBox «No ha seleccionado directorio carpeta Word, seleccione directorio .», , «AVISO»
Exit Sub
End If
TextBox3 = path3
Sheets(«Configuracion»).Cells(2, «C») = TextBox3
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path4 As String
On Error Resume Next
path4 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path4 = «» Then
MsgBox «No ha seleccionado directorio carpeta Excel, seleccione directorio .», , «AVISO»
Exit Sub
End If
TextBox4 = path4
Sheets(«Configuracion»).Cells(2, «D») = TextBox4
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub UserForm_Initialize()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Sheets(«Parametros»)
TextBox1 = a.Cells(2, «C»)
TextBox2 = a.Cells(2, «D»)
TextBox3 = a.Cells(2, «E»)
TextBox4 = a.Cells(2, «F»)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub UserForm_Terminate()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Sheets(«Parametros»)
a.Cells(2, «C») = TextBox1
a.Cells(2, «D») = TextBox2
a.Cells(2, «E») = TextBox3
a.Cells(2, «F») = TextBox4
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Código que va en el userform4


Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim uf, ucw, r1, r2, Cb1, Cb2, Cb3, Cb4, or1, or2, or3, or4 As String
Dim cri1, cri2, cri3, cri4 As String
Dim x, ucn As Integer
Set a = Sheets(«Estadisticas»)
a.Select

‘rango de datos a filtrar
pf = 21
uf = a.Range(«A» & Rows.Count).End(xlUp).Row – 1
If a.Range(«A» & uf + 1) <> «Total:» Then uf = a.Range(«A» & Rows.Count).End(xlUp).Row

uc = a.Cells(21, Columns.Count).End(xlToLeft).Address
pc = a.Cells(21, Columns.Count).End(xlToLeft).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)
wc1 = Mid(pc, InStr(pc, «$») + 1, InStr(2, pc, «$») – 2)
r5 = wc1 & pf & «:» & wc & uf

‘Verifica que no se seleccione el mismo criterio de orden en caso que el combobox no este vacio

If ComboBox1 = Empty Then
MsgBox («Debe ingresar criterio de orden 1»), vbInformation, «AVISO»
ComboBox1.SetFocus
Exit Sub
End If

If ComboBox2 <> Empty Then
If ComboBox1 = Empty Then
MsgBox («Ingrese criterio de orden 1»), vbInformation, «ALERTA»
ComboBox1.SetFocus
Exit Sub
End If

If ComboBox2 = ComboBox1 Or ComboBox2 = ComboBox3 Or ComboBox2 = ComboBox4 Then
MsgBox («El criterio de orden está duplicado, verifique»), vbInformation, «ALERTA»
ComboBox2.SetFocus
Exit Sub
End If
End If

If ComboBox3 <> Empty Then

If ComboBox2 = Empty Then
MsgBox («Ingrese criterio de orden 2»), vbInformation, «ALERTA»
ComboBox2.SetFocus
Exit Sub
End If

If ComboBox3 = ComboBox1 Or ComboBox3 = ComboBox2 Or ComboBox3 = ComboBox4 Then
MsgBox («El criterio de orden está duplicado, verifique»), vbInformation, «ALERTA»
ComboBox2.SetFocus
Exit Sub
End If
End If

If ComboBox4 <> Empty Then

If ComboBox3 = Empty Then
MsgBox («Ingrese criterio de orden 3»), vbInformation, «ALERTA»
ComboBox3.SetFocus
Exit Sub
End If

If ComboBox4 = ComboBox1 Or ComboBox4 = ComboBox2 Or ComboBox4 = ComboBox3 Then
MsgBox («El criterio de orden está duplicado, verifique»), vbInformation, «ALERTA»
ComboBox2.SetFocus
Exit Sub
End If
End If

‘Determino el valor de cada combobox y en base a ello el rango donde esta el criteri de orden
For x = 1 To 9
If a.Cells(21, x) = ComboBox1 Then
k = a.Cells(21, x).Address(False, False)
k1 = Mid(k, 1, 1)
r1 = k & «:» & k1 & uf
End If
Next x

For x = 1 To 9
If a.Cells(21, x) = ComboBox2 Then
k = a.Cells(21, x).Address(False, False)
k1 = Mid(k, 1, 1)
r2 = k & «:» & k1 & uf
End If
Next x

For x = 1 To 9
If a.Cells(21, x) = ComboBox3 Then
k = a.Cells(21, x).Address(False, False)
k1 = Mid(k, 1, 1)
r3 = k & «:» & k1 & uf
End If
Next x

For x = 1 To 9
If a.Cells(21, x) = ComboBox4 Then
k = a.Cells(21, x).Address(False, False)
k1 = Mid(k, 1, 1)
r4 = k & «:» & k1 & uf
End If
Next x

If OptionButton1 = False Then
or1 = xlDescending
Else
or1 = xlAscending
End If

If OptionButton3 = False Then
or2 = xlDescending
Else
or2 = xlAscending
End If

If OptionButton5 = False Then
or3 = xlDescending
Else
or3 = xlAscending
End If

If OptionButton7 = False Then
or4 = xlDescending
Else
or4 = xlAscending
End If

‘sorts the data
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Clear

If ComboBox1 <> Empty And ComboBox2 = Empty And ComboBox3 = Empty And ComboBox4 = Empty Then
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r1) _
, SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 = Empty And ComboBox4 = Empty Then
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r1) _
, SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r2) _
, SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 <> Empty And ComboBox4 = Empty Then
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r1) _
, SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r2) _
, SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r3) _
, SortOn:=xlSortOnValues, Order:=or3, DataOption:=xlSortNormal
End If

If ComboBox1 <> Empty And ComboBox2 <> Empty And ComboBox3 <> Empty And ComboBox4 <> Empty Then
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r1) _
, SortOn:=xlSortOnValues, Order:=or1, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r2) _
, SortOn:=xlSortOnValues, Order:=or2, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r3) _
, SortOn:=xlSortOnValues, Order:=or3, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(«Estadisticas»).Sort.SortFields.Add Key:=Range(r4) _
, SortOn:=xlSortOnValues, Order:=or4, DataOption:=xlSortNormal
End If

With ActiveWorkbook.Worksheets(«Estadisticas»).Sort
.SetRange Range(r5)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

‘a.Cells(1, 1).Select
MsgBox («Los datos se han ordenado con éxito»), vbInformation, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton3_Click()
ComboBox1 = Clear
ComboBox2 = Clear
ComboBox3 = Clear
ComboBox4 = Clear
End Sub

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Set a = Sheets(«Estadisticas»)
a.Range(«A21»).Select
While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell
ComboBox2.AddItem ActiveCell
ComboBox3.AddItem ActiveCell
ComboBox4.AddItem ActiveCell
ActiveCell.Offset(0, 1).Select
Wend
Application.ScreenUpdating = True
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407

Summary
Author Rating
1star1star1star1star1star
Aggregate Rating
no rating based on 0 votes