AGREGAR INFORMACIÓN DEL PROCESO REALIZADO EN LA EJECUCIÓN DE UNA MACRO O UN PROGRAMA EN VBA

Hola a todos 🙂

Hace unos días estuve implementado un proceso en VBA que duraba varios minutos (incluso programándolo de la forma más eficiente).

Esto me hizo reflexionar acerca de la conveniencia de agregar algún tipo de indicado que me mostrase de alguna manera el procentaje de trabajo realizado por la macro.

Lo que no quería era insertar una barra de progreso, (crear un userform, el insertar una etiqueta, un frame y programarlo todo). Pero recordé que con el uso de la propiedad Application.StatusBar (barra de estado), podría crear una sencilla línea de código que me mostrase lo que necesitaba.

Os lo explico con un ejemplo, voy a recurrir a un pequeño ejercicio que publiqué en su día sobre cómo buscar con varios criterios en VBA. En ese proceso utilizábamos varias
instrucciones for-next  y eso nos vendrá muy bien para programar nuestra barra de estado.

En el ejemplo tenemos una hoja (TABLABASE) con la información de los automóviles matriculados en España hasta abril 2016, según marca, tipo de combustible y Comunidad Autónoma de residencia. Y en otra hoja (DATOS), la misma información pero solo de los automóviles diesel. El ejercicio es buscar la información en la tabla principal siguiendo los tres primeros criterios y añadiendo el total en la columna Datos:

AGREGAR INFORMACION DEL PROCESO REALIZADO EN LA EJECUCI0N DE UNA MACRO O UN PROGRAMA EN VBA

Voy a conservar el mismo código que en el del post anterior y añadiré la nueva línea de código que hará lo que estamos buscando (resalto en azul):

Sub BUSCAR_INDICADOR_DE_PROGRESO()
'Declaramos variables
Dim i As Double
Dim j As Double
Dim Marca As String, Carburante As String, Comunidad As String
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Refrescamos la columna de total por cada búsqueda que hagamos
With Worksheets("DATOS")
Total = Application.CountA(.Range("D:D"))
If Total > 1 Then .Range("D2:D" & Total).ClearContents
End With
'Definimos rango de tablabase
fin = Application.CountA(Worksheets("TABLABASE").Range("A:A"))
'Definimos rango de datos
Final = Application.CountA(Worksheets("DATOS").Range("A:A"))
With Worksheets("TABLABASE")
'Iniciamos el bucle principal en tabla Datos
For i = 2 To Final
'Definimos cada uno de los Items por los que vamos a buscar
Marca = Sheets("DATOS").Cells(i, 1)
Carburante = Sheets("DATOS").Cells(i, 2)
Comunidad = Sheets("DATOS").Cells(i, 3)
'Segundo bucle en tablabase por cada item del primer bucle
For j = 2 To fin
'Buscamos con un condicional en tablabase cada una de las variables definidas
If Marca = .Cells(j, 1) And _
Carburante = .Cells(j, 2) And _
Comunidad = .Cells(j, 3) Then
'si encontramos coincidencia, igualamos celdas con el valor de la columna 4
Sheets("DATOS").Cells(i, 4) = .Cells(j, 4)
Exit For
End If
Next
'Insertamos mensaje en barra de tareas para mostrar % completo de la ejecución de la macro
Application.StatusBar = "Progreso: " & i & " de " & Final & " Porcentaje completado: " & Format(i / Final, "0%")
Next
End With
Application.ScreenUpdating = True
End Sub

Como podéis observar, nos ayudamos con los datos del primer bucle for-next dado que es el proceso principal (va recorriendo cada línea) y nos muestra la información de cual es el registro que está en uso (la variable “i”) y cual es el número total de registros que nuestro proceso debe recorrer (variable “Final”).

Con esa información ya podemos confeccionar nuestra barra de esta perfectamente:

Application.StatusBar = "Progreso: " & i & " de " & Final & " Porcentaje completado: " & Format(i / Final, "0%")

Una vez que ejecutemos la macro nos mostrará el proceso de esta forma:

AGREGAR INFORMACION DEL PROCESO REALIZADO EN LA EJECUCI0N DE UNA MACRO O UN PROGRAMA EN VBA1

La clave es disponer de variables numéricas que nos permitan expresar los datos en %, y colocar el código en el bucle correspondiente (que debe ser el principal o el que de alguna forma nos pueda indicar el progreso de nuestro código). No tendrá sentido usar esta propiedad en macros que se ejecutan en pocos segundos.

Pues eso es todo, estoy seguro que os será de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: AGREGAR INFORMACIÓN DEL PROCESO REALIZADO EN LA EJECUCIÓN DE UNA MACRO O UN PROGRAMA EN VBA

 

Anuncios

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NÚMEROS

Hola a todos:

Hace unos días respondí a una consulta en la que un lector me preguntaba sobre la forma de incorporar a un proceso un código que pudiese reemplazar determinados caracteres, por ejemplo: la ñ por la n.

La aplicación que estaba desarrollando iniciaba consultas a internet y necesitaba controlar que estos caracteres se reemplazasen por los que él indicaba. Además también necesitaba hacer algunas modificaciones con otros datos en los que debía reemplazar algunos números por otros.

Para realizar esta tarea, opté por hacer uso de una estructura Select Case, dado que me permitía realizar todo lo que me pedía.

Veámoslo con un ejemplo sencillo, tenemos varias informaciones en las cuatro primeras líneas:

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NUMERO

Para el primer caso, se necesita cambiar la ñ por una n, en los siguientes casos, si los números son el 1, el 2 o el 3, debemos mostrar un 1, si son el 4, el 5 o el 6 debemos mostrar un 2 y si son el 7, el 8 o el 9, un 3. Y en la última fila varios números combinamos.

Pues bien, para hacer este ejercicio vamos a utilizar la siguiente macro:

Sub EJEMPLO_SELECT_CASE()
'Definimos variables
Dim sDato As String, nItem As String
Dim i As Integer, j As Integer, sLargo As Integer
With Sheets("DATOS")
Final = Application.CountA(.Range("A:A"))
'Iniciamos bucle por cada celda de la columna A
For i = 2 To Final
sLargo = Len(.Cells(i, 1))
'Si hay datos entonces iniciamos segundo bucle
If sLargo > 0 Then
'Extraemos cada carácter de la celda seleccionada
For j = 1 To sLargo
nItem = Mid(.Cells(i, 1), j, 1)
'Iniciamos estructura Select Case
Select Case nItem
Case "Ñ"
nItem = "N"
Case "ñ"
nItem = "n"
Case 0 To 3
nItem = "1"
Case 4 To 6
nItem = "2"
Case 7 To 9
nItem = "3"
End Select
'Agrupamos de nuevo la palabra
sDato = sDato & nItem
Next j
End If
'Pasamos el dato a la columna B
.Cells(i, 2) = sDato
'Igualamos Sdato a 0
sDato = 0
'Seguimos con la próxima palabra/string
Next i
End With
End Sub

Como podéis observar, tenemos varios bucles for – next, uno para recorrer las filas y otro para recorrer la cadena de texto dentro de esa fila.

A continuación aplicamos el Select Case que hemos programado según los parámetros requeridos, cambiar la ñ por la n (también si es mayúscula) y por grupo de números para obtener este resultado:

ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NUMERO1

Como podéis observar, los cambios se realizan según lo esperado, y podríamos seguir añadiendo condiciones o (casos) a nuestro Select según nuestras necesidades.

Y esto ha sido todo, espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: ESTRUCTURA SELECT CASE PARA REEMPLAZAR CARACTERES EN UNA CADENA DE TEXTO O NÚMERO

 

CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXIÓN DE DATOS EXTERNOS Y VBA

Hola a todos 🙂

Espero que todo os vaya bien!

La verdad es que llevo unas semanas con un montón de consultas y como siempre con muy poco tiempo disponible. Muchos de vosotros estáis buscando formas y métodos para hacer de vuestro trabajo una experiencia mucho más eficiente y fiable.

La programación es sin duda la forma de hacerlo!. Hoy volvemos parcialmente sobre un tema ampliamente tratado en este blog, la consolidación o agrupación de archivos de Excel (en este post tenéis acceso a las publicaciones relacionadas: AGRUPAR INFORMACIÓN DE VARIOS LIBROS EN UNA HOJA EXCEL).

Pero hoy la diferencia es que vamos a consolidar información de varios archivos CSV (archivos delimitados por comas) y que también nos va a servir para archivos de texto (TXT).

Tuve mis dudas sobre el método a utilizar, pero finalmente me he inclinado por usar en parte una de las herramientas predefinidas en Excel: Conectarse con datos externos (Importar) y hacer así la tarea un poco más rápida.

La razón de escribir este post se debe a una consulta recibida estos últimos días donde un lector preguntaba cómo podía consolidar la información de varios archivos CSV en una sola hoja de Excel, obviamente cada campo separado por comas en una columna.

Como siempre, vamos a utilizar un pequeño ejemplo: imaginad que tenemos cuatro archivos CSV:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA

En el que consta la información de cuatro grupos de estudiantes en los que se describe: ID, NOMBRE, CLASE, ASIGNATURAS Y CALIFICACIONES, y la coma es el delimitador de cada campo:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA1

Pues bien, para poder realizar este trabajo, vamos a usar la siguiente macro:

Sub IMPORTAR_CSV()
'Definimos Variables
Dim Consulta As QueryTable, nArchivos As Variant, j As Long, i As Long
Dim uFila As Long, Conexiones As Object
'Seleccionamos archivos
nArchivos = Application.GetOpenFilename(FileFilter:="Text Files (*.CSV),*.CSV", _
Title:="Seleccionar archivos a importar", MultiSelect:=True)
'Si no seleccionamos nada, salimos del proceso
If IsArray(nArchivos) = False Then Exit Sub
'Dimensionamos datos
For j = LBound(nArchivos) To UBound(nArchivos)
nArchivos(j) = "TEXT;" & nArchivos(j)
Next j
For j = LBound(nArchivos) To UBound(nArchivos)
'Comprobamos la última fila con datos de la columna A
With Sheets("CONSOLIDADO")
If Application.CountA(.Range("A:A")) = 0 Then
uFila = 1
Else
uFila = Application.CountA(.Range("A:A")) + 1
End If
'Iniciamos la consulta
Set Consulta = .QueryTables.Add(Connection:=nArchivos(j), Destination:=.Range("A" & uFila))
'Indicamos parámetros de la consulta que nos interesan:
With Consulta
.Name = "Datos"
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
Next j
'Eliminamos todas las conexiones que hemos iniciado.
For Each Conexiones In ActiveWorkbook.Connections
Conexiones.Delete
Next Conexiones
End Sub

Como podéis observar, estamos utilizando una consulta (querytables) para importar la información y colocarla según el delimitador que tenemos, que en este caso es una coma. Si fuese punto y coma  por que es un texto, bastaría sustituir en la macro:

.TextFileCommaDelimiter = True

por esto:

.TextFileSemicolonDelimiter = True

Y donde ponemos CSV en Application.GetOpenFilename poner TXT. Pero como estamos tratando con archivos CSV, dejamos la coma.

Una vez que ejecutamos la macro, la información consolidada quedaría así:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA2

Como podéis ver, hemos agrupado todos los archivos, según los especificado en los CSV y en el código.

OJO La parte final de la macro elimina todas las conexiones del libro y por lo tanto todas las que hemos creado para importar la información.

For Each Conexiones In ActiveWorkbook.Connections
Conexiones.Delete
Next Conexiones

Aunque lo normal es dejar las conexión por si las queremos actualizar, en este caso no tiene sentido dado que estamos consolidando informaciones de muchos ficheros y además supondría tener cientos de conexiones en la archivo, por ejemplo, en este, sin eliminarlas se verían así:

EJEMPLOS_CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXION DE DATOS EXTERNOS Y VBA3

Si las queréis conservar, simplemente eliminad esa parte de la macro o dejadla como está, pero tened en cuenta que borra todas las conexiones del libro.

Sobre los parámetros, vosotros mismos podéis configurarlos, o bien consultáis en el soporte de microsoft sobre el objeto QueryTables o con el grabador de macros, grabáis una importación y añadís a la macro las especificaciones que necesitéis.

Y esto es todo, os dejo la macro para que la probéis y espero que en algún momento os sea de utilidad.

 

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR VARIOS ARCHIVOS CSV O TXT USANDO CONEXIÓN DE DATOS EXTERNOS Y VBA

Los archivos de prueba los subo en una carpeta a Google Drive: ARCHIVOS DE EJEMPLO PARA PRUEBAS

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA

Hola a todos!

En nuestro trabajo es muy habitual que recibamos archivos con extensión .zip, es decir, que han sido comprimidos previamente para reducir su tamaño y poder así enviarlos más fácilmente.

Aunque actualmente esta información se suele subir a la “nube” para evitar problemas de envío y tamaño de archivos, lo cierto es que se sigue usando habitualmente la compresión.

En Internet hay multitud de códigos en VBA y otros lenguajes para extraer los archivos o carpetas en ZIP. Haciendo un muestreo de dichos códigos y tras volver a programar algunos métodos para hacerlos más eficientes, os dejo la siguiente macro:

Sub DESCOMPRIMIR_ZIP()
'Definimos variables
Dim objShell As Object
Dim iArchivo As Variant, Nombre_Carpeta As Variant
Dim Ruta As String, i As Long
Dim objScripting, objCarpeta
'Seleccionamos archivos zip
iArchivo = Application.GetOpenFilename(filefilter:="Archivos ZIP (*.zip), *.zip", MultiSelect:=True)
'Si no seleccionamos nada, salimos del proceso
If IsArray(iArchivo) = False Then Exit Sub
'Indicamos el directorio actual de nuestro archivo o donde queremos crear o guardar nuestros archivos
Ruta = Application.ActiveWorkbook.Path & "\"
'Nombramos la carpeta en la que vamos a descomprimir los ZIP
Nombre_Carpeta = Ruta & "ARCHIVOS EXTRAIDOS " & Replace(Date, "/", "_") & " " & Format(Now, "hh_mm_ss") & "\"
'Creamos la carpeta con el nombre anterior
Set objScripting = CreateObject("Scripting.FileSystemObject")
Set objCarpeta = objScripting.CreateFolder(Nombre_Carpeta)
'Procedemos a copiar los archivos y carpetas de los ZIP seleccionados a nuestra nueva carpeta
Set objShell = CreateObject("Shell.Application")
For i = LBound(iArchivo) To UBound(iArchivo)
objShell.Namespace(Nombre_Carpeta).CopyHere objShell.Namespace(iArchivo(i)).items
Next i
Set objScripting = Nothing
Set objCarpeta = Nothing
Set objShell = Nothing
End Sub

Cuando ejecutamos el código, se nos abrirá una ventana de diálogo para seleccionar los archivos ZIP. Para este ejemplo he comprimido la carpeta con los archivos de mi última entrada:

* Aunque la imagen parece un archivo .RAR no lo es, en WinRAR podemos comprimir también en ZIP. Solo que el icono no es de siempre, sino el de WinRAR, pero la extensión es .ZIP.

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA3

Cuando pulsamos en Abrir, la macro generará una capeta en el directorio que hemos especificado en el código, (en este caso en el mismo lugar en el que hayamos guardado el archivo Excel con la macro. La carpeta se nombrará con el nombre “ARCHIVOS EXTRAIDOS” y con la fecha y hora del momento, así no tendremos problemas por duplicidad en el nombre de las carpetas. Así:

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA1

Y dentro de esta carpeta, estará la información que tenemos en el ZIP:

DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA2

Obviamente, podemos indicar cualquier otro destino para la creación de la carpeta, por ejemplo, si queremos que se cree en el escritorio, debemos indicarlo en la macro (en mi equipo sería así:

Ruta = "C:\Users\Segu\Desktop" & "\"

Por otra parte, también he implementado con otro método más eficiente que MKDir la manera de crear una carpeta:

Set objScripting = CreateObject("Scripting.FileSystemObject")
Set objCarpeta = objScripting.CreateFolder(Nombre_Carpeta)

Ojo, este código sirve únicamente para extensiones .ZIP no para .RAR (que espero programar y mostrar en breve).

Y esto ha sido todo, espero que os sea de utilidad para ahorra tiempo en vuestros procesos.

Descarga el archivo de ejemplo pulsando en: DESCOMPRIMIR ARCHIVOS .ZIP DESDE EXCEL CON VBA

 

INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL

Hola a todos 🙂

Hace pocos días que publiqué mi último post pero hoy aprovecho que tengo algo de tiempo para escribir uno nuevo.

Será un post muy breve dado que se trata de la modificación del código de un post anterior: INSERTAR FILAS INTERCALADAS EN BLANCO EN EXCEL

Y el motivo de la modificación del código es una consulta recibida en la que me preguntaban “buenísimo! y si quiero que lo haga a nivel celda en una sola columna? =)

Pues es relativamente sencillo, dado que en el código anterior insertábamos filas en blanco, en esta versión insertaremos celdas en blanco en la columna seleccionada.

Siguiendo con el ejemplo, tenemos la siguiente tabla:

INSERTAR FILAS INTERCALADAS EN BLANCO EN EXCEL

Y lo que vamos a hacer es intercalar una celda en blanco en las columnas de “Jueves” y “Sábado”. Para ello, vamos a utilizar

Sub Insertar_celdas()
'Definimos variables
Dim tTop, rFila, i, j As Double
'Buscamos el número de columna en el que estamos
nColum = ActiveCell.Column
'Buscamos la letra de la columna en la que estamos
lColum = Split(ActiveCell.Address, "$")(1)
'Determinamos el rango para definir la longitud del bucle for-next
Rango = lColum & ":" & lColum
'Indicamos el número de línea sobre el que comenzamos a añadir celdas en blanco
tTop = 3
'Indicamos el número de celdas en blanco a incluir
rFila = 1
fin = Application.CountA(ActiveSheet.Range(Rango))
For j = 2 To fin
'Si la primera celda (en este caso la 3) contiene un valor,
'entonces comenzamos a insertar celdas intercaladas
If Not IsEmpty(Cells(tTop, nColum)) Then
For i = 1 To rFila
Cells(tTop, nColum).Insert Shift:=xlDown
Next i
tTop = tTop + rFila + 1
End If
Next j
End Sub

Para acabar, en el ejemplo que os dejo, he utilizado, al igual que en la entrada anterior, otra macro para activar esta macro:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.OnKey "{ESCAPE}", "Insertar_celdas"
End Sub

La macro se activa pulsando la tecla “Escape. Pero podéis ejecutarla perfectamente vinculándola a un botón o ejecutándola directamente sobre el código.

Es decir, os posicionáis con el cursor encima de la columna “E” (Jueves) y pulsáis la tecla “Esc” y hacéis lo mismo con la columna “G” (Sábado).

El resultado es el siguiente:

INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL

Y ya está, como habéis podido observar, solo hemos cambiado la línea de código que insertaba filas vacías por esta otra:

Cells(tTop, nColum).Insert Shift:=xlDown

Y eso es todo, una pequeña modificación en la macro y obtenemos lo que necesitamos 🙂

Dado que estoy utilizando una macro que usa la combinación de teclas para activar la macro principal, a la hora de descargar el archivo os generará un error en tiempo de ejecución del método On Key. Este se puede corregir usando On Error Resume Next:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Application.OnKey "{ESCAPE}", "Insertar_celdas"
On Error GoTo 0
End Sub

Pero no tiene mucho sentido dado que solo os ocurrirá cuando descarguéis el archivo, de todas formas os lo comento para vuestra información.

Una vez guardado, no se volverá a reproducir este error. O, como ya dije, podéis ejecutarlo vinculándolo a un botón o cualquier otro evento.

Descarga el archivo de ejemplo pulsando en: INSERTAR CELDAS INTERCALADAS EN BLANCO EN EXCEL

 

APLICAR FORMATO DE FECHA A UNA CADENA DE TEXTO USANDO ADO EN VBA

Hola a todos 🙂

Espero que os vaya muy bien!. En el post de hoy vamos a trabajar con ADO para dar formato de fecha a una cadena de texto.

El tema de las fechas aunque puede parecer sencillo, siempre es susceptible de complicarse. Y en muchas ocasiones el problema se debe al formato con el que llegan los datos que nos envían. En el post de hoy vamos a trabajar uno de esos formatos.

Vamos a ilustrarlo con un ejemplo, imaginad que abrís una petición en la red a favor del control de horarios y ruidos de los locales de ocio nocturno (¡todo un reto!). Y la aplicación que ha recogido los datos os envía un archivo con la siguiente información:

DAR FORMATO DE FECHA A UNA CADENA DE TEXTO USANDO ADO EN VBA

Efectivamente, los campos NOMBRE, PETICIÓN y FIRMA no tienen nada de particular, pero el campo FECHA DE FIRMA debería contar con un formato de fecha y si embargo nos llega como un texto. Esto es un problema, dado que a priori no vamos a poder trabajar fácilmente con este tipo de fechas y es más, necesitamos exportar algunas de las columnas del fichero a otra aplicación para generar otro tipo de informaciones.

Hemos elegido ADO para transferir la información de la hoja BASE a la hoja INFORMACIÓN y será en ese proceso en el que vamos a utilizar SQL para formatear las fechas y también controlar aquellas celdas que se encuentren vacías.

Para hacer el trabajo, os dejo esta macro que es capaz formatear solo las celdas que contienen la fecha:

Sub CONEXION_SQL_FECHAS()
'Declaramos variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection
Dim Fin As Integer, i As Long, MiLibro As String, Tit As String
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Eliminamos datos de hoja INFORMACION anteriores
Sheets("INFORMACION").Select
With Sheets("INFORMACION")
'Eliminamos datos de la consulTa SQL anterior
Fin = Application.CountA(.Range("A:A"))
If Fin > 0 Then .Range("A2:D" & Fin).ClearContents
'Realizamos consulta SQL, y componemos un string para crear los datos y darle formato de fecha
obSQL = "SELECT [BASE$].[NOMBRE], [BASE$].[PETICION], [BASE$].[FIRMA], " & _
"IIF(NOT ISNULL([BASE$].[FECHA DE FIRMA]),CDATE(MID([BASE$].[FECHA DE FIRMA],1,2) & '/' & MID([BASE$].[FECHA DE FIRMA],3,2) & '/' & MID([BASE$].[FECHA DE FIRMA],5,4)),NULL) AS [FECHA DE FIRMA] " & _
"FROM [BASE$] "
MiLibro = ActiveWorkbook.Name
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Grabamos la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
'Pegamos datos y añadimos encabezados
Do Until Dataread.EOF
Dataread.MoveFirst
.Cells(2, 1).CopyFromRecordset Dataread
For i = 0 To Dataread.Fields.Count - 1
Tit = Dataread.Fields(i).Name
.Cells(1, i + 1) = Tit
Next
Loop
'Por seguridad formateamos la columna FECHA DE FIRMA a fecha
.Columns("D:D").NumberFormat = "m/d/yyyy"
'liberamos y desconectamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End With
Application.ScreenUpdating = True
End Sub

Como podéis observar,  usamos ADO para importar la información de una hoja a la otra, y en el proceso aprovechamos para realizar los cambios y controles necesarios. En concreto, en esta sentencia SQL:

"IIF(NOT ISNULL([BASE$].[FECHA DE FIRMA]),CDATE(MID([BASE$].[FECHA DE FIRMA],1,2) & '/' & MID([BASE$].[FECHA DE FIRMA],3,2) & '/' & MID([BASE$].[FECHA DE FIRMA],5,4)),NULL) AS [FECHA DE FIRMA]

Donde controlamos que solo sean formateadas las celdas que contienen datos usando un IIF que valida si son nulas. Si no lo son, componemos una nueva cadena de texto creando la fecha y aplicamos la función CDate que nos devolverá una expresión tipo fecha, ¡Justo lo que queremos!.

Una vez ejecutada la macro, el resultado es el siguiente:

DAR FORMATO DE FECHA A UNA CADENA DE TEXTO USANDO ADO EN VBA1

Este es un ejemplo muy concreto donde los datos a formatear deben ser texto, de hecho, cuando no nos envían la información con formato de fecha, casi siempre viene así.

Antes de finalizar, os recuerdo la necesidad de marcar en las referencias la librería de ADO Activex Data Objects 2.8 Library, es importante que lo hagáis, de lo contrario, la macro no va a funcionar:

exportar-una-tabla-o-consulta-de-access-a-excel-con-ado2

Y eso es todo, espero que os resulte de utilidad a la hora de trabajar con fechas en Excel 🙂

Descarga el archivo de ejemplo pulsando en: APLICAR FORMATO DE FECHA A UNA CADENA DE TEXTO USANDO ADO EN VBA

 

CALCULAR LA EDAD CON DATEDIF EN UN FORMULARIO DE EXCEL

Hola a todos, espero que estéis bien y supongo que ya disfrutando de vacaciones (a mí aún me quedan unas semanas para comenzarlas).

En el post de hoy vamos a tratar de resolver una consulta que me enviaron la semana pasada sobre un tema que ya hace tiempo que tenía ganas de abordar. La pregunta era cómo se podía calcular la edad en un formulario de Excel.

Bien, existen varios post sobre el cálculo de la edad en esta web, y en todas ellas usamos la función SIFECHA() de excel, que normalmente la usamos en la hoja y en menor medida en VBA. En VBA esta función se denomina DATEDIF (y NO es lo mismo que otra función denominada DATEDIFF, que trabaja con valores absolutos).

Esta función, si utilizamos la grabadora de datos para obtener su traducción en VBA sería algo así:

AÑO = "=DATEDIF(RC[-12],TODAY(),""Y"")"

Es decir, nos ofrece la posibilidad de generar la fórmula en la hoja desde VBA. Pero lo cierto es que queremos trabajar con esta función sin acudir a la hoja en ningún momento, simplemente utilizar el formulario y los parámetros que hayamos incluido para calcular la edad de una persona.

Aunque esta función no existe en VBA como tal, podemos invocarla a través del método EVALUATE, aunque eso lo iremos viendo en el caso particular que nos ocupa.

Vamos a imaginar que tenemos un formulario con un cuadro de texto (textbox1) en el que debemos incluir la fecha de nacimiento, un botón de comando para ejecutar la macro y otro cuadro de texto (textbox2) en el que vamos a mostrar la edad completa:

CALCULAR LA EDAD EN UN FORMULARIO

Para calcular la edad vamos a incluir en modulo asociado al botón de comando el siguiente código:

Private Sub CommandButton1_Click()
'Definimos variables
Dim validarfecha As Boolean
Dim hoy As String
Dim f_nac As String
Dim año As Double, mes As Double, dia As Double
'Trabajamos con el formulario1
With UserForm1
'Cada vez que ejecutemos la macro vaciaremos el textbox1
.TextBox2 = Empty
'Si no existe fecha o el dato no es una fecha o está mal escrita, activamos mensaje y salimos el cálculo
validarfecha = IsDate(.TextBox1.Value)
If .TextBox1.Value = Empty Or validarfecha = False Or Len(.TextBox1.Value) > 10 Then
MsgBox ("DEBES INTRODUCIR UNA FECHA Y VERIFICAR QUE EL FORMATO SEA EL ADECUADO"), vbExclamation, "CONTROL"
Exit Sub
End If
'Si la fecha es mayor que la fecha actual, activamos mensaje y salimos el cálculo
If CDate(.TextBox1.Value) > Date Then
MsgBox ("LA FECHA NO PUEDE SER MAYOR QUE EL DÍA ACTUAL"), vbExclamation, "CONTROL"
Exit Sub
Exit Sub
End If
'Indicamos la fecha de hoy con formato mm/dd/aaaa y lo componemos en un string
hoy = (Month(Date) & "/" & Day(Date) & "/" & Year(Date))
'Indicamos la fecha de hoy con formato mm/dd/aaaa y lo componemos en un string
f_nac = (Month(.TextBox1.Value) & "/" & Day(.TextBox1.Value) & "/" & Year(.TextBox1.Value))
'Evaluamos la función Datedif para año, mes y día
año = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""Y"")")
mes = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""YM"")")
dia = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""MD"")")
'Pasamos el string con los años, meses y días de nuestra edad actual al textbox2
.TextBox2 = año & IIf(año = 1, " año", " años") & ", " & mes & IIf(mes = 1, " mes", " meses") & " y " & dia & IIf(dia = 1, " dia", " días")
End With
End Sub

Es importante tener en cuenta que la función reconoce la fecha con formato mm/dd/aaaa por lo que debemos especificar esto tanto para la variable que contiene la fecha actual “hoy” como para la que contiene la fecha de nacimiento “f_nac”. Esto lo podemos solucionar componiendo un string con la fecha en el orden indicado.

En el cuadro de texto de la fecha de nacimiento el formato es el habitual: días, meses y años. Si necesitáis introducir los datos con otro formato, tendréis que modificar la macro en los dos string creados para que la función lea adecuadamente la información.

Luego debemos adaptar la función para trabajar con variables y evaluarla con el método Evaluate. Importante el uso de las comillas.

El resultado es el siguiente (calculado sábado 22 de Julio de 2017 a las 23:22 horas):

CALCULAR LA EDAD EN UN FORMULARIO1

Y el resultado es el correcto (y también lo es que me voy haciendo más viejo). El formulario me muestra información completa de la edad que tengo en el momento de ejecutar el código.

He incluido en la macro varios controles: si no existe fecha, si la fecha está mal escrita o si es mayor que el día actual. Si sucede alguna de estas cosas, mostrará un mensaje y proceso finalizará.

Según configuraciones regionales las fechas tendrán formatos distintos, sin embargo, creo que adaptando la macro a meses, días y años funcionará en todos los lugares (siempre que escribamos la fecha de nacimiento con día, mes y año.

Pues esto ha sido todo, espero que os sea de utilidad a la hora de crear formularios o de poner en práctica la función Datedif en VBA.

Descarga el archivo de ejemplo pulsando en: CALCULAR LA EDAD EN UN FORMULARIO DE EXCEL