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

 

Anuncios

EXTRAER REGISTROS √öNICOS CON UNA CONSULTA SQL USANDO DISTINCT

Hola a todos ūüôā

Espero que todo vaya bien!. Llevo unos días con ganas de escribir este post, pero la verdad es que me habéis enviado bastantes consultas, y ya sabéis que lo primero es atender las dudas de los lectores y luego escribir las entradas del blog.

El post de hoy surge por una consulta en la que se me ped√≠a una macro para extraer registros √ļnicos de una hoja a otra. As√≠ como para extraer los registros √ļnicos dentro de la misma hoja podemos usar el filtro avanzado, y as√≠ lo publique en su momento: EXTRAER REGISTROS √öNICOS CON FILTRO AVANZADO EN VBA, para pasarlo a otra hoja debemos utilizar otro tipo de c√≥digo, de hecho podemos utilizar diferentes m√©todos.

Hoy veremos uno de ellos, utilizaremos ADO y una consulta SQL en la que incluyendo la palabra clave DISTINCT podremos extraer los registros √ļnicos a otra hoja.

Vamos con el siguiente ejemplo, imaginad que tenemos nuestra hoja de Excel con una serie de registros duplicados:

EXTRAER REGISTROS √öNICOS CON UNA CONSULTA SQL USANDO DISTINCT

Y queremos pasar a la hoja UNICOS todos los registros SIN duplicados. Para ello vamos utilizar el siguiente código:

Sub CONSULTA_SQL_UNICOS()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection, i As Integer, MiLibro As String
'Limpiamos hoja con los registros √ļnicos
Eliminar = Application.CountA(Worksheets("UNICOS").Range("A:A"))
If Eliminar > 0 Then Worksheets("UNICOS").Range("A1:GG" & Eliminar).ClearContents
'realizamos consulta SQL incorporando la palabra clave Distinct
obSQL = "SELECT distinct * FROM [DATOS$] "
'Guardamos el nombre del libro activo
MiLibro = ActiveWorkbook.Name
'Realizamos la conexión ADO
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
'Procedemos a grababar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja UNICOS
With Worksheets("UNICOS").Select
Worksheets("UNICOS").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de columna
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
dfecha = CDate(Dataread.Fields(i).Name)
Else
dfecha = Dataread.Fields(i).Name
End If
Worksheets("UNICOS").Cells(1, i + 1) = dfecha
Next
Loop
End Sub

Ya sabéis que para este tipo de método es necesario activar la referencia Microsoft ActiveX Data Object 2.8 Library en el editor de VBA:

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

Siguiendo con el código, lo realmente importante es que en la consulta SQL estamos utilizando la palabra clave DISTINCT, la cual elimina los registros que se encuentran duplicados. El resto del código es el que solemos utilizar en esta web para este tipo de consultas.

El resultado de aplicar la macro es el siguiente:

EXTRAER REGISTROS √öNICOS CON UNA CONSULTA SQL USANDO DISTINCT1

Como podéis ver, ya tenemos nuestros datos sin duplicados.

Y esto es todo, en pr√≥ximos post, publicar√© otra forma m√°s sencilla de extraer registros √ļnicos. Espero que os sea de utilidad, como siempre os dejo la macro:

Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS CON UNA CONSULTA SQL USANDO DISTINCT

 

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNI√ďN

Hola a todos:

Hace unos días recibí una consulta acerca de cómo agrupar la información de varias hojas en una hoja específica del mismo libro.

Aunque tengo publicaciones con macros para agrupar información de varios libros,  el método utilizado fue mediante bucles (For Рnext). Para esta petición utilizaré otro método, trabajaré con ADO y realizaré una consulta de UNION para consolidar la información de las hojas seleccionadas.

Dado que el usuario tendrá siempre la misma estructura en la información de esas hojas y además serán tres, esta macro será perfecta para este trabajo. Con ADO conseguiremos mayor rapidez en la ejecución del código y, si cabe mayor claridad.

Veamos las tres hojas que vamos a consolidar, las llamaré TABLA1, TABLA2 y TABLA3 y la hoja que recibirá toda la información se llamará CONSOLIDADO:

La estructura sería esta:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION

Tal como podéis ver, cada una de las tablas tiene la misma estructura que la que muestro arriba. Un ID, Nombre, Estudios, Inglés, Vehículo, Provincia y Edad.

Antes de poner la macro, me gustaría volver a incidir en que es imprescindible que las tablas tengan las mismas columnas con los mismos nombres. Si esto no es así, la macro no funcionará.

Ahora sí, ya podéis pegar el siguiente código en un módulo estándar:

Sub CONSULTA_SQL_UNION()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection, i As Integer, MiLibro As String
'Limpiamos hoja que consolida, CONSOLIDADO
Eliminar = Application.CountA(Worksheets("CONSOLIDADO").Range("A:A"))
If Eliminar > 0 Then Worksheets("CONSOLIDADO").Range("A1:GG" & Eliminar).ClearContents
'realizamos consulta SQL de UNION y no tenemos en cuenta los registros nulos
obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"
'Guardamos el nombre del libro activo
MiLibro = ActiveWorkbook.Name
'Realizamos la conexión ADO
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
'Procedemos a grababar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja CONSOLIDADO
With Worksheets("CONSOLIDADO").Select
Worksheets("CONSOLIDADO").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de columna
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
dfecha = CDate(Dataread.Fields(i).Name)
Else
dfecha = Dataread.Fields(i).Name
End If
Worksheets("CONSOLIDADO").Cells(1, i + 1) = dfecha
Next
Loop
End Sub

Antes de ejecutar el código debéis verificar que tenéis la referencia: Microsoft ActiveX Data Object 2.8 Library. En este archivo no es necesario que la marquéis (ya la he marcado yo), pero si pegáis el códido en un libro nuevo, sí que la tendréis que marcar.

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

El resultado de aplicar la macro es el siguiente:

CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNION1

Y ya tenemos los registros de las hojas especificadas en la hoja CONSOLIDADO. En este c√≥digo si existen duplicados, es decir dos filas o m√°s id√©nticas, importar√° solo uno, y tambi√©n si existen elementos nulos (null) no los tendr√° en cuenta. Si queremos que tuviese en cuenta los duplicados, es decir, que los importase, debemos poner “ALL” despu√©s de UNION, de esta forma estaremos especificando que unimos todo (incluidos duplicados):

obSQL = "SELECT * FROM [TABLA1$] WHERE NOT [TABLA1$].[ID] IS NULL UNION ALL " & _ "SELECT * FROM [TABLA2$] WHERE NOT [TABLA2$].[ID] IS NULL UNION ALL " & _
"SELECT * FROM [TABLA3$] WHERE NOT [TABLA3$].[ID] IS NULL"

Obviamente, sobre los nulos, no vamos a querer que se cuelen filas en blanco o con caracteres extra√Īos, por eso resulta imprescindible incluir en la sentencia el famoso Not Is Null ūüôā

Y esto ha sido todo, os dejo el archivo de ejemplo:

Descarga el archivo de ejemplo pulsando en:¬†CONSOLIDAR HOJAS DE UN LIBRO CON UNA CONSULTA SQL DE UNI√ďN

 

EXPORTAR UNA TABLA O CONSULTA DE ACCESS A EXCEL CON ADO

Hola a todos:

Aunque esta web est√° dedicada b√°sicamente a Excel, hoy voy a trabajar un poco con Access. En muchas ocasiones, cuando combinamos ambos programas (Excel y Access) obtenemos grandes resultados. El tema de hoy trata precisamente de c√≥mo podemos realizar un peque√Īo proceso en ADO para exportar una tabla o consulta que tenemos en Access (desde Access).

Sobre ADO hay bastantes ejemplos en esta web, pero en ninguno de ellos programo directamente en Access, hoy lo voy a hacer.

Utilizaremos un ejemplo simple, para ello tenemos una tabla en Access con los datos de los empleados de unos grandes almacenes (la base de datos que siempre pongo de ejemplo):

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

Esta tabla se denomina DATOS y nuestra intención es exportarla a Excel. Para ello vamos a utilizar la siguiente macro que pegaremos en el editor de VBA de Access:

Option Compare Database
Sub ExporExcel()
Dim APIExcel As Object
Dim AddLibro As Object
Dim AddHoja As Object
Dim nombreHoja As String
Dim i As Integer
Dim consulta As New ADODB.Recordset
'Creamos conexión y recorset
Set cnn = CurrentProject.Connection
consulta.Open "SELECT * FROM DATOS", cnn, adOpenForwardOnly, adLockReadOnly
'Damos nombre a la hoja con la que vamos a exportar los datos
nombreHoja = "DATOS"
'Creamos objeto excel y nuevo libro y no mostramos el archivo
Set APIExcel = CreateObject("Excel.Application")
Set AddLibro = APIExcel.Workbooks.Add
APIExcel.Visible = False
'A√Īadimos hoja al libro nuevo y nombramos pesta√Īa
Set AddHoja = AddLibro.Worksheets(1)
If Len(nombreHoja) > 0 Then AddHoja.Name = Left(nombreHoja, 30)
'Traemos los datos de cabecera de la tabla Access y los pegamos en la hoja excel
columnas = consulta.Fields.Count
For i = 0 To columnas - 1
APIExcel.Cells(1, i + 1) = consulta.Fields(i).Name
Next i
'Pegamos los datos de la tabla en la nueva hoja
consulta.MoveFirst
AddHoja.Range("A2").CopyFromRecordset consulta
'Damos formato a las columnas, ajustando contenidos
With APIExcel.ActiveSheet.Cells
.Select
.EntireColumn.AutoFit
.Range("A1").Select
End With
'Mostramos la hoja
APIExcel.Visible = True
'cerramos los objetos de la consulta
consulta.Close
cnn.Close
End Sub

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 ahora que tenemos la macro lista, podemos ejecutarla y veremos como la macro, crea un archivo Excel y pasa los datos de la consulta a una pesta√Īa que va a renombrar con el nombre de DATOS.

En la propia macro ya os voy comentando qu√© es lo que hace cada l√≠nea de c√≥digo, as√≠ que no quiero ser repetitivo, pero es interensate el uso de “CurrentProject.Connection” dado que nos ahorra todo el trabajo de definir la conexi√≥n.

El resultado de la macro es el siguiente:

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

Y esto ha sido todo, espero que os resulte de inter√©s y de utilidad ūüôā

Os dejo el arhcivo en Google Drive (en WordPress no es posible subir archivos de Access).

Descarga el archivo de ejemplo pulsando en: EXPORTAR UNA TABLA O CONSULTA DE ACCESS A EXCEL CON ADO

LOGARSE CON EL NOMBRE DE USUARIO DEL EQUIPO PARA ACCEDER A EXCEL

Muy a menudo, cuando realizamos nuestros proyectos en Excel y no queremos que la informaci√≥n sea p√ļblica porque queremos restringirla a ciertos usuarios, solemos utilizar macros para confeccionar di√°logos de contrase√Īas, por ejemplo para abrir un userform, en esta web ya tratamos este tema aqu√≠.

L√≥gicamente, esto cobra especial importancia cuando trabajamos en red dado que nuestro archivo es accesible a un gran n√ļmero de usuarios. Para solucionar esta problem√°tica de seguridad, podemos recurrir a claves, que no siempre son la soluci√≥n ideal, dado que se pueden compartir, o prestar, etc.¬† provocando que no sepamos realmente quien accede a nuestra informaci√≥n. O podemos utilizar el nombre del usuario activo en el equipo que se conecta para tener controlados los accesos.

¬ŅC√≥mo lo hacemos?. ¬†Es sencillo, teniendo en cuenta el siguiente c√≥digo:

Set objNetwork = CreateObject("WScript.Network")
UserName = objNetwork.UserName

Con √©l podemos conocer el nombre del usuario que se encuentra activo en el equipo. Con este dato ya tenemos suficiente para crear nuestro sistema de seguridad. Aunque estoy seguro que con esta informaci√≥n ya la adaptar√©is sin problema a vuestros equipos, por mi parte, voy a realizar un peque√Īo ejemplo para que ve√°is como se puede implementar.

Imaginad que tenemos un archivo en el que hemos desarrollado un programa realizado con formularios y lo colocamos en un directorio com√ļn al que solo queremos que accedan ciertos usuarios. En ese formulario (que lo vamos denominar como ‚ÄúINFORMACI√ďN‚ÄĚ), hemos colocado un textbox que cuando el usuario tenga permiso de acceso, mostrar√° que est√° conectado y se pondr√° de color verde. En caso de que no lo est√© no le mostrar√° nada, simplemente el ‚ÄúINFORMACI√ďN‚ÄĚ no se mostrar√°.

Vamos entonces a implementar un código que realice lo que hemos comentado. La macro que vamos utilizar es la siguiente:

Private Sub UserForm_Initialize()
Dim cnn As New ADODB.Connection
Dim recSet As New ADODB.Recordset
Dim strSQL As String
Dim objNetwork As Object
INFORMACION.TextBox1.BackColor = vbWhite
'OBTENEMOS EL NOMBRE DE USUARIO ACTIVO EN EL EQUIPO
Set objNetwork = CreateObject("WScript.Network")
UserName = objNetwork.UserName
'CONECTAMOS CON EL ARCHIVO QUE CONTIENE EL NOMBRE DE LOS USUARIOS
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE= " & ThisWorkbook.Path & "\" & "LOGARSE_CON_EL_NOMBRE_DE_USUARIO_DEL_EQUIPO.xls"
.Properties("Extended Properties") = "Excel 12.0; HDR=YES"
.Open
End With
'CON UNA CONSULTA SQL COMPROBAMOS SI EXISTE EL USUARIO DEL EQUIPO EN NUESTRA BASE DE DATOS
strSQL = "SELECT [DATOS$].[USUARIO] " & _
"FROM [DATOS$] " & _
"WHERE[DATOS$].[USUARIO] = " & " '" & UserName & "'"
recSet.Open strSQL, cnn
strTexto = recSet![Usuario]
'SI EXISTE, EXTRAEMOS EL NOMBRE Y ES IGUAL AL DEL EQUIPO, MOSTRAMOS EN EL FORM MENSAJE DE CONECTADO
'SI NO EXISTE, EL MODULO ThisWorkBook controlar√° el error.
With INFORMACION
If UserName = strTexto Then
.TextBox1.Value = "USUARIO: (" & UCase(UserName) & ") EST√Ā CONECTADO"
.TextBox1.BackColor = vbGreen
End If
End With
'DESCONECTAMOS
recSet.Close: Set recSet = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Este c√≥digo lo colocaremos en el userform, en el evento “Initialize”, de forma que se ejecutar√° cuando ‚ÄúINFORMACI√ďN‚ÄĚ se muestre.

Como podéis ver, en la macro nos estamos conectando y realizando una consulta SQL a otra hoja para comprobar qué usuario actual está en nuestra base de datos. En este caso he utilizado el mismo archivo, pero lo lógico es conectarse a otro archivo diferente que contenga esta base de datos o incluso también a un base de datos en Access en otro directorio. Pero como ejemplo nos sirve.

Aqu√≠ nos conectamos a nuestro propio archivo, y consultamos los datos que se encuentran en la hoja denominada ‚ÄúDATOS‚ÄĚ, donde est√° el listado de usuarios permitidos. Autom√°ticamente, si todo es correcto, ‚ÄúINFORMACI√ďN‚ÄĚ se mostrar√° y aparecer√° el textbox en verde con el nombre de usuario concectado.

En caso de que no exista, el sistema mostrar√° un error y no se abrir√°¬†nada. Pero para controlar el error y mostrar un cuadro de di√°logo que diga, por ejemplo: “EXISTE UN PROBLEMA CON SU USUARIO”. Vamos a incluir este c√≥digo en el m√≥dulo ThisWorkBook, en el evento Workbook_Open¬†:

Private Sub Workbook_Open()
'Si en el momento de mostrar el formulario INFORMACION
'aparece el error 3021 (no encuentra el usuario, o no es correcto)
'INFORMACI√ďN no se abrir√° y mostraremos un MsgBox advirtiendo del motivo
On Error GoTo Usuario
INFORMACION.Show
Usuario:
If Err.Number = "3021" Then MsgBox ("EXISTE UN PROBLEMA CON SU USUARIO"), vbExclamation, "CONTROL USUARIOS"
End Sub

Una vez hayáis implementado todos pasos, y si vuestro usuario coincide con el que consta en la base de datos, el userform se abrirá y mostrará esta información:

LOGARSE CON EL NOMBRE DE USUARIO DEL EQUIPO PARA ACCEDER A EXCEL

Y este sistema lo pod√©is implementar en un sinf√≠n de situaciones y seg√ļn vuestras necesidades. Es interesante porque mantenemos el control de nuestras aplicaciones desde otro lugar, sin necesidad de entregar claves ni proteger la informaci√≥n, simplemente damos o no acceso.

Descarga el archivo de ejemplo pulsando en: LOGARSE CON EL NOMBRE DE USUARIO DEL EQUIPO PARA ACCEDER A EXCEL

 

COMBOBOX DEPENDIENTES EN USERFORM CON SQL

ISuele ser una consulta recurrente en Excel el tema de los combobox dependientes, y es que para algunas aplicaciones o proyectos donde el usuario ha de seleccionar ciertos √≠tems con dependencia entre ellos, el uso de los combos dependientes es realmente √ļtil.

Se pueden realizar combos dependientes de diversas formas, pero siempre vamos a tener que usar VBA, (al contrario de Access, donde esta posibilidad está incluida en los formularios). Esta vez, además de hacerlo a través de VBA vamos a implementar el ejercicio con ADO y SQL para obtener el mismo resultado.

Este ejemplo voy a realizarlo en un userform, pero también os dejaré el ejemplo en una hoja Excel. Los que leéis esta web habitualmente ya sabéis que si vamos a usar ADO, debemos habilitar en nuestro editor VBA las siguientes referencias:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL

Ahora ya podemos comenzar con el post. Utilizaremos para este ejemplo la base de datos habitual de los grandes almacenes, pero utilizamos los siguientes campos:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL1

Una vez que tenemos estos datos y los campos que vamos a mostrar en los combos (en este caso ser√°n 4), ya podemos ir a VBA e insertar los combobox:

COMBOBOX DEPENDIENTES EN USERFORM CON SQL2

Teniendo en cuenta que el userform lo he denominado “DEPENDIENTES”, deb√©is pegar en c√≥digo del userform, la siguiente macro:

Private Sub UserForm_Initialize()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
'Realizamos consulta sql para seleccionar con datos agrupados todos los departamentos,
'incluimos is not null, por si en la hoja excel tenemos al final de la base de datos registros en blanco.
sSQL = "SELECT [DATOS$].[SECCION] FROM [DATOS$] WHERE [DATOS$].[SECCION] Is NOT Null " & _
"GROUP BY [DATOS$].[SECCION]"
'limpiamos combobox1
.ComboBox1.Clear
Set Dataread = Recset(sSQL, cnn)
'Con un bucle do cargamos desde el recordset los datos de sección en el combo1
Do Until Dataread.EOF
DEPENDIENTES.ComboBox1.AddItem Dataread("SECCION")
Dataread.MoveNext
Loop
End With
'Desconectamos
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Esta primera macro se inicia cuando el userform se inicializa, b√°sicamente lo que hace es cargar el Combobox1 con los datos de “Secci√≥n” y agrupados (registros √ļnicos). Le he incluido un “is not null”, por si al final de la base de datos existiesen registros nulos o en blanco que ocasionen un error de carga.

Pero si os hab√©is fijado, en la macro he incluido dos “set” llamando a dos funciones:¬†Abre_Cnn y¬†Recset(sSQL, cnn)

Estas dos funciones declaradas publicas, son necesarias para la conexión con la base de datos y con el recordset que grabará información de cada consulta. De esta forma nos evitamos tener que escribir en cada macro el mismo código para conectar y grabar, y simplemente cuando lo necesitemos, invocamos las funciones.

Son estas y también se deben incluir en código del formulario:

Public Function Abre_Cnn() As ADODB.Connection
'Con esta función realizamos la conección con la base de datos
Dim cnn As New ADODB.Connection
Dim bBien As Boolean
bBien = True
On Error GoTo ControlaError
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE= " & ThisWorkbook.Path & "\" & "COMBOBOXUSERFORM.xls"
.Properties("Extended Properties") = "Excel 12.0; HDR=YES"
.Open
End With
SALIR:
Set Abre_Cnn = cnn
Exit Function
ControlaError:
bBien = False
Resume SALIR
End Function

Es importante que teng√°is en cuenta que la fuente de datos siempre ha de tener la referencia del archivo donde se encuentran los datos y tambi√©n pod√©is especificar una ubicaci√≥n en otra carpeta, en este caso, es el archivo en uso, es decir, el actual: ¬†“DATA SOURCE= ” & ThisWorkbook.Path & “\” & “COMBOBOXUSERFORM.xls”

Public Function Recset(ByVal sSQL As String, ByRef cnn As ADODB.Connection) As ADODB.Recordset
'Con esta función utilizamos el recordset para grabar la información que cargará cada combo
Dim Dataread As New ADODB.Recordset
Dim bBien As Boolean
bBien = True
On Error GoTo ControlaError
With Dataread
.Source = sSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
SALIR:
Set Recset = Dataread
Exit Function
ControlaError:
bBien = False
Resume SALIR
End Function

Ahora que tenemos cargado el combobox1, debemos ir cargando el resto de combos y que vayan haciendo referencia al combo anterior de forma que sean así dependientes. En el código de cada combo debéis insertar cada una de estas macros:

En el Combobox1:

Private Sub ComboBox1_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
'realizamos consulta seleccionando los estudios filtrados seg√ļn la seccion a la que pertenecen
sSQL = "SELECT [DATOS$].[ESTUDIOS] FROM [DATOS$]" & _
"WHERE [DATOS$].[ESTUDIOS] AND [DATOS$].[SECCION]='" & vSeccion & "' " & _
"GROUP BY [DATOS$].[ESTUDIOS]"
Set Dataread = Recset(sSQL, cnn)
'limpiamos resto de combos
.ComboBox2.Clear
.ComboBox3.Clear
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo2 con el recordset
Do Until Dataread.EOF
.ComboBox2.AddItem Dataread("ESTUDIOS")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

En el Combobox2:

Private Sub ComboBox2_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
'Llamamos a función Abre_Cnn para conectarnos con la base de datos
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
vEstudios = .ComboBox2.Value
'realizamos consulta seleccionando el idioma filtrado seg√ļn la seccion a la que pertenecen y los estudios que poseen
sSQL = "SELECT [DATOS$].[IDIOMA] FROM [DATOS$] WHERE" & _
"[DATOS$].[IDIOMA] AND [DATOS$].[ESTUDIOS]='" & vEstudios & "' AND [DATOS$].[SECCION]='" & vSeccion & "' " & _
"GROUP BY [DATOS$].[IDIOMA]"
Set Dataread = Recset(sSQL, cnn)
.ComboBox3.Clear
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo3 con el recordset
Do Until Dataread.EOF
.ComboBox3.AddItem Dataread("IDIOMA")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

En el Combobox3

Private Sub ComboBox3_Change()
Dim Dataread As ADODB.Recordset, sSQL As String, cnn As ADODB.Connection
Set cnn = Abre_Cnn
With DEPENDIENTES
vSeccion = .ComboBox1.Value
vEstudios = .ComboBox2.Value
vIdioma = .ComboBox3.Value
'realizamos consulta seleccionando la persona filtrada seg√ļn la seccion a la que pertenecen y los estudios que poseen y los idiomas
sSQL = "SELECT [DATOS$].[NOMBRE COMPLETO] FROM [DATOS$]" & _
"WHERE [DATOS$].[IDIOMA] AND [DATOS$].[ESTUDIOS]='" & vEstudios & "' AND [DATOS$].[SECCION]='" & vSeccion & "' AND [DATOS$].[IDIOMA]='" & vIdioma & "' " & _
"GROUP BY [DATOS$].[NOMBRE COMPLETO]"
Set Dataread = Recset(sSQL, cnn)
.ComboBox4.Clear
'cargamos el resultado de la consulta en el combo4 con el recordset
Do Until Dataread.EOF
.ComboBox4.AddItem Dataread("NOMBRE COMPLETO")
Dataread.MoveNext
Loop
End With
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Ni que decir tiene que para adaptar estas macros a vuestros proyectos es necesario que teng√°is en cuenta el nombres de los campos y la sintaxis SQL.

Finalmente tendréis los cuatro combos dependientes los unos de los otros, y quedaría así.

COMBOBOX DEPENDIENTES EN USERFORM CON SQL3

Este trabajo también se puede hacer en VBA sin incluir SQL ni ADO, pero me ha parecido muy interesante desarrollarlo con de esta forma.

Adicionalmente os dejo otro archivo pero sin el userform, donde he insertado directamente los combobox en la hoja Excel. Existen algunas modificaciones, la macro se inicializa con un evento “Activate” en la hoja “COMBOS”, para cargar el primer Combobox. La diferencia entre uno y otro archivo es que en uno hacemos referencia al userform y en el otro a la hoja.

Sobre el archivo que contiene los combos en la hoja Excel, os comento que tiene una peque√Īa macro en ThisWorkbook, para que antes de cerrar no guarde los cambios (esto es porque el evento de activar la hoja y subir los datos a los combos, hacen que aunque no hag√°is nada en la hoja, cuando la cerr√°is siempre os solicite guardar o no cambios.

ThisWorkbook.Saved = True
Application.Quit
End Sub

Si no la necesit√°is, solo ten√©is que borrarla, a vuestro gusto ūüôā

Os dejo los dos archivos y si tenéis dudas, ya sabéis, me lo comentáis.

Ahora, como siempre, os dejo los dos archivos ūüôā ¬†espero que os sean de utilidad.

Descarga el archivo de ejemplo pulsando en: COMBOBOX EN USERFORM

Descarga el archivo de ejemplo pulsando en: COMBOBOX EN HOJA

 

REALIZAR CONSULTA SQL DESDE VBA EN EXCEL, HACER UNA CONSULTA DE ACCESS EN EXCEL

Hola a todos,

¬ŅQu√© tal est√°is?, espero que bien ūüôā ¬†Si record√°is en el anterior post coment√© que en la pr√≥xima entrada mostrar√≠a un ejemplo de como podemos utilizar una consulta sql en excel, o lo que es muy parecido, como replicar una consulta que hemos hecho utilizando Access pero en Excel. Pues bien, hoy es lo que vamos a ver.

Lo primero que voy a hacer es realizar la consulta en Access y luego replicarla en Excel, de forma que se pueda ver claramente el proceso y la comparaci√≥n. Imaginemos que estamos trabajando para una empresa que vende jamones … nos llamamos La Pata Negra, S.L. y resulta que somos los encargados de seleccionar dentro de la plantilla de la empresa a un nuevo comercial para que venda nuestros productos.

Como es habitual, el jefe nos entrega una relaci√≥n de empleados (que tiene desde hace tiempo y no est√° actualizada, es decir, hay empleados que ya no est√°n y hay otros nuevos que no tiene, a esta tabla vamos a llamarla “Listado”. Por otro lado hemos conseguido que desde el departamento de personal nos env√≠en un archivo con la informaci√≥n actualizada de los empleados as√≠ como una serie de datos, a esta tabla vamos a llamarla “Datos”.

Nuestro trabajo va a ser sencillo, como en la primera tabla sabemos que algunos empleados pueden ya no estar y en la segunda sabemos que est√°n todos, debemos cruzar los datos y obtener detalle de los empleados antiguos (que puedan seguir en la empresa) y los nuevos.

Estas serían las tablas:CONSULTAS_SQL_1

y la consulta a realizar (muy b√°sica), ser√≠a la siguiente: necesitamos buscar aquellos empleados que est√©n en la tabla “Datos” y que adem√°s coincidan con los que est√°n en la tabla “Listado” de forma que vamos a obtener los empleados antiguos que siguen en la actualidad y tambi√©n los nuevos. Pero adem√°s queremos que busque aquellos que tengan estudios de “MASTER“, que vivan en “MADRID” y que tengan menos de “30” a√Īos.

En Access la consulta ser√≠a esta, SIEMPRE uniendo por el campo IDENTIFICADOR, que es un registro √ļnico para cada empleado:
CONSULTAS_SQL_2

 

Donde adem√°s queremos que nos muestre informaci√≥n de “INGL√ČS” y si posee “VEHICULO”. Una vez ejecutada la consulta nos ofrece a cuatro candidatos que poseen los requisitos que hemos definido previamente:
CONSULTAS_SQL_3

Ahora solo faltar√≠a tomar una decisi√≥n de a qui√©n seleccionar en base a criterios que ya no ser√≠an tema este blog ūüôā

EN EXCEL

Pues ahora esto mismo lo voy a realizar en Excel. Para ello debemos contar con las dos tablas de referencia, “DATOS” y “LISTADO” que vamos importar a Excel, cada una en una hoja y agregamos una tercera que vamos a llamar “RESULTADO”, que es donde mostremos el resultado de la consulta:CONSULTAS_SQL_4

Antes de continuar y mostrar el código que voy a utilizar, os comento que es necesario que actualicéis referencias en el libro de Excel, en concreto debéis marcar las siguiente para que la conexión de ADO funcione correctamente. Esto lo tenéis que hacer entrando en el editor de Visual pinchar en Herramientas y luego en Referencias. Y una vez que se abra el cuadro para elegir las referencias, marcáis las siguientes. (las referencias se quedan en el libro, por lo que en este archivo no hace falta que las marquéis, pero sí será necesario en un nuevo libro).

CONSULTAS_SQL_5
Ahora que tenemos la hoja preparada para el código, lo voy a poner completo para luego comentarlo:

Código  completo:
Public Sub CONSULTA_SQL()
'Definimos las variables y creamos los
Dim Dataread As ADODB.Recordset, obSQL As String, Res As String
Dim cnn As ADODB.Connection
'Cada vez que ejecutemos la consulta borramos los datos de la consulta anterior en la hoja resultado_
'si se produce un error por estar la hoja vacía, saltamos directamente al proceso de consulta a través de la etiqueta control_e
On Error GoTo control_e
LIMPIARDATOS = Application.CountA(Worksheets("RESULTADO").Range("a:a"))
Worksheets("RESULTADO").Range("A1:G" & LIMPIARDATOS).ClearContents
Worksheets("RESULTADO").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
control_e:
'indicamos los par√°metros de la consulta SQL
obSQL = "SELECT [DATOS$].[IDENTIFICADOR], [DATOS$].[NOMBRE], [DATOS$].[ESTUDIOS] , [DATOS$].[INGLES],[DATOS$].[VEHICULO],[DATOS$].[PROVINCIA],[DATOS$].[EDAD]" & _
"FROM [LISTADO$] RIGHT JOIN [DATOS$] ON [LISTADO$].[IDENTIFICADOR] = [DATOS$].[IDENTIFICADOR]" & _
"WHERE((([DATOS$].[ESTUDIOS]) ='MASTER') AND (([DATOS$].[PROVINCIA]) ='MADRID') AND (([DATOS$].[EDAD]) <30))"
'Creamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\CONSULTA_SQL_EN_EXCEL.xls"
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grabar los datos de la consulta creando el objeto recordset
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
Res = obRes & Dataread.Fields(0).Value & " " & Dataread.Fields(1).Value
Dataread.MoveFirst
'Copiamos los datos a la hoja RESULTADO
With Worksheets("RESULTADO").Select
Worksheets("RESULTADO").Cells(2, 1).CopyFromRecordset Dataread
End With
'Grabamos los nombres de cada encabezado de columna
With Worksheets("RESULTADO")
.Range("a1") = ("IDENTIFICADOR")
.Range("B1") = ("NOMBRE")
.Range("C1") = ("ESTUDIOS")
.Range("D1") = ("INGLES")
.Range("E1") = ("VEHICULO")
.Range("F1") = ("PROVINCIA")
.Range("G1") = ("EDAD")
End With
'Pintamos de rojo Los encabezados
With Worksheets("RESULTADO")
.Range("A1").Interior.Color = vbRed
.Range("B1").Interior.Color = vbRed
.Range("C1").Interior.Color = vbRed
.Range("D1").Interior.Color = vbRed
.Range("E1").Interior.Color = vbRed
.Range("F1").Interior.Color = vbRed
.Range("G1").Interior.Color = vbRed
End With
Loop
End Sub

Como podéis ver, básicamente lo que hacemos es realizar una consulta ADO entre ambas hojas para conseguir el resultado indicado.

La consulta SQL es muy parecida a la que se realiza desde Access:
obSQL = "SELECT [DATOS$].[IDENTIFICADOR], [DATOS$].[NOMBRE], [DATOS$].[ESTUDIOS] , [DATOS$].[INGLES],[DATOS$].[VEHICULO],[DATOS$].[PROVINCIA],[DATOS$].[EDAD]" & _
"FROM [LISTADO$] RIGHT JOIN [DATOS$] ON [LISTADO$].[IDENTIFICADOR] = [DATOS$].[IDENTIFICADOR]" & _
"WHERE((([DATOS$].[ESTUDIOS]) ='MASTER') AND (([DATOS$].[PROVINCIA]) ='MADRID') AND (([DATOS$].[EDAD]) <30))"

Ahora la vamos a comentar, primero determinamos aquellos campos que necesitamos que sean visibles:
"SELECT [DATOS$].[IDENTIFICADOR], [DATOS$].[NOMBRE], [DATOS$].[ESTUDIOS] , [DATOS$].[INGLES],[DATOS$].[VEHICULO],[DATOS$].[PROVINCIA],[DATOS$].[EDAD]"

Luego indicamos a partir de qu√© tablas y que relaci√≥n de consulta vamos a realizar. En este caso queremos saber todos aquellos que se encuentran en la tabla Datos y los que tienen el mismo identificador en la tabla “Listado”. Es decir la opci√≥n tres que se expresa en la consulta de Access:

CONSULTAS_SQL_6

Para ello escribimos RIGHT JOIN * y unimos las tablas por el campo [IDENTIFICADOR], así:
"FROM [LISTADO$] RIGHT JOIN [DATOS$] ON [LISTADO$].[IDENTIFICADOR] = [DATOS$].[IDENTIFICADOR]"

(*) Los otros dos tipos de consulta son LEFT JOIN (Opción 2) o INNER JOIN (Opción 3).

El siguiente paso es indicar que queremos que sus estudios sean MASTER, que sean de MADRID y que tengan menos de 30 a√Īos:
"WHERE((([DATOS$].[ESTUDIOS]) ='MASTER') AND (([DATOS$].[PROVINCIA]) ='MADRID') AND (([DATOS$].[EDAD]) <30))"

El resto de la macro lo que hace es grabar la consulta en un recordset y devolver el resultado con los par√°metros indicados en la hoja RESULTADO. He incluido un control para errores cuando al ejecutar la macro y limpiemos los datos de la consulta, que siempre deber√≠a existir alg√ļn contenido, en caso de no tener contenido, no se produzca un error.

El resultado ser√≠a el siguiente, ¬Ņos resulta familiar?
CONSULTAS_SQL_7

Efectivamente, es el mismo resultado que utilizando Access.

Casi se me olvida, la fuente de los datos que se indica en el código (en rojo) ha de hacer referencia (ser el mismo) al nombre de nuestro archivo Excel.
.ConnectionString = “DATA SOURCE=” & Application.ActiveWorkbook.Path + “\CONSULTA_SQL_EN_EXCEL.xls

Importante: si vinculáis la hoja con otro archivo y es diferente de .xls debéis modificar en la conexión los siguientes elementos:

.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0; HDR=YES"

Como siempre os dejo el ejemplo para que prob√©is con un caso pr√°ctico, os he a√Īadido un bot√≥n para ejecutar la macro en la hoja LISTADO.

Descarga el archivo de ejemplo pulsando en: CONSULTA_SQL_EN_EXCEL