ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

Hola a todos:

En el post anterior hemos visto una nueva técnica para obtener registros únicos usando el objeto “Diccionario”: ELIMINAR REGISTROS DUPLICADOS Y CARGAR DATOS ÚNICOS EN COMBOBOX Y LISTBOX

Entre las consultas que me enviaron los lectores, una de ellas era sobre si se podían ordenar esos datos una vez eliminados los duplicados y pasar esa información al combobox y al listbox. Como me pareció útil e interesante, he decidido crear un nuevo post como continuación al anterior (de esta forma se verá más claro).

Partiendo de una información diferente, no meses, sino por nombre de personas:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION

Vamos a hacer el mismo ejercicio que en post anterior, es decir, eliminar duplicados, ordenar la información y pasar los datos a un combobox y a un listbox:

Sub CARGAR_UNICOS_ORDENADOS()
'Declaramos las variables
Dim rango As Range, celda As Object, oDic As Object, npalabra As String
Dim sCadena As String, sCadena1 As String, ipalabra As String, OrdenarAlfa As Variant
Dim matriz As Variant, matriz1 As Variant, palabra As Variant, alfadato As Variant
Dim i As Long, j As Long, fin As Integer
'Trabajamos con la hoja
With Sheets("UNICOS")
'Limpiamos combo y listbox
.ComboBox1.Clear
.ListBox1.Clear
'Definimos el rango de los datos
fin = .Range("A" & Rows.Count).End(xlUp).Row
'Trabajamos con rango establecido
Set rango = .Range("A2:A" & fin)
'Por cada celda del rango componemos un string
For Each celda In rango
If celda <> vbNullString Then
ipalabra = ipalabra & "," & celda
End If
Next celda
'Eliminamos posibles espacios en blanco
sCadena = Trim(Mid(ipalabra, 2, Len(ipalabra)))
'Comprobamos que cada palabra que incluimos en la matriz no existe en cadena
matriz = Split(sCadena, ",")
Set oDic = CreateObject("scripting.dictionary")
For i = 0 To UBound(matriz)
If Not oDic.Exists(matriz(i)) Then oDic.Add matriz(i), matriz(i)
Next i
'Creamos una nueva cadena ya sin duplicados
sCadena1 = Join(oDic.Keys, ",")
'Pasamos los datos a una matriz
Set matriz1 = CreateObject("System.Collections.ArrayList")
'Y ordenamos las palabras
For Each palabra In Split(sCadena1, ",")
matriz1.Add palabra
Next palabra
matriz1.Sort
'Pasamos de nuevo las palabras ordenadas a un string
For Each alfadato In matriz1
npalabra = npalabra & "," & alfadato
Next alfadato
OrdenarAlfa = Split(Trim(Mid(npalabra, 2, Len(npalabra))), ",")
'Pasamos los datos al Combo y al listbox
For j = 0 To UBound(OrdenarAlfa)
.ComboBox1.AddItem (OrdenarAlfa(j))
.ListBox1.AddItem (OrdenarAlfa(j))
Next
'Limpiamos variable de objeto
Set rango = Nothing
Set oDic = Nothing
End With
End Sub

Si vais observando la construcción de la macro, podéis ver que hemos incluido un pequeño subproceso en el código a través del cual volvemos a pasar los datos del rango a una matriz y los ordenamos con la propiedad “.sort”.

El resto del código es igual que el ejemplo anterior, y para que veáis cómo funciona, os dejo el resultado:

ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABETICAMENTE LA INFORMACION1

Como podéis observar, hemos conseguir el objetivo propuesto, los datos se han cargado sin duplicados y se han ordenado alfabéticamente.

Descarga el archivo de ejemplo pulsando en: ELIMINAR REGISTROS DUPLICADOS Y ORDENAR ALFABÉTICAMENTE LA INFORMACIÓN

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios

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

 
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO

Hace unos días recibí una consulta sobre formularios, la petición en concreto era sobre la necesidad de pasar la información seleccionada en varios listbox de un formulario a los mismo listbox pero en otro formulario.

Además, pedía que aunque se seleccionasen listbox diferentes, se pasase la misma información al segundo formulario y sin duplicar los datos.

Aunque puede parecer una consulta sencilla, la especificación de poder seleccionar cualquier item en cualquier listbox y que la información no se duplique durante el proceso, hacen que requiera un desarrollo a medida.

El post anterior, en el que trataba acerca de cargar datos en un listbox y realizar consultas y filtros con SQL y ADO, ya formaba parte de esta consulta, solo que no quería publicar un post demasiado extenso cuando se puede hacer en dos partes y bien explicado 🙂

Por lo tanto, vamos a utilizar el formulario del post: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL que cargaba los datos que previamente habíamos seleccionado a través de los criterios indicados en un buscador, por ejemplo todos los nombres que contienen una “A”.

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO1

Ahora lo que se pide es pasar los items que queramos seleccionar a un segundo formulario (para nosotros userform2). Por ejemplo así:

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO2

Como podéis ver, seleccionamos en una ocasión el nombre, en otra la asignatura y en otra la calificación.

Para poder exportar esta selección debemos incluir un botón de comando y pegar el siguiente código:

Private Sub CommandButton2_Click()
'Declaramos las variables
Dim i As Integer, j As Integer, n As Integer
Dim Lista As MSForms.ListBox
Dim nLista As MSForms.ListBox
Dim Control As Control
'Contamos el número de Listbox en el formulario
For Each Control In Me.Controls
If TypeName(Control) = "ListBox" Then
Lbox = Lbox + 1
End If
Next
'Primer bucle: recorremos todos los formularios
For j = 1 To Lbox
Set Lista = Me.Controls("Listbox" & j)
'Segundo bucle: por cada formulario, recorremos los item que contiene
'y detectamos el item seleccionado.
For i = 0 To Lista.ListCount - 1
If Lista.Selected(i) = True Then
'Tercer bucle, volvemos a recorrer todos los items
' y si existen varios items seleccionados en la misma fila (misma persona)
'desmarcamos todos menos el primero (evitando así duplicados).
For n = j + 1 To Lbox
Set nLista = Me.Controls("Listbox" & n)
If nLista.Selected(i) = True Then nLista.Selected(i) = False
Next n
'Pasamos los datos seleccionados al formulario 2
UserForm2.ListBox1.AddItem Me.ListBox1.List(i)
UserForm2.ListBox2.AddItem Me.ListBox2.List(i)
UserForm2.ListBox3.AddItem Me.ListBox3.List(i)
UserForm2.ListBox4.AddItem Me.ListBox4.List(i)
UserForm2.ListBox5.AddItem Me.ListBox5.List(i)
End If
Next i
Next j
'Mostramos formulario 2
UserForm2.Show
End Sub

Una vez pulsado el botón, se muestra el formulario 2 con los datos que hemos seleccionado. Es decir, realiza la tarea correctamente.

EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO3

Pero ¿qué pasaría si seleccionamos para un mismo item (o persona) varias informaciones?, en lógica si el código importa todo lo seleccionado … ¡duplicaría la información!

Pero esto se soluciona con la siguiente parte del código: donde indicamos que si un ítem ha sido seleccionado varias veces, solo tenga en cuenta la primera de ellas, de esta forma no duplicaremos la información:

For n = j + 1 To Lbox
Set nLista = Me.Controls("Listbox" & n)
If nLista.Selected(i) = True Then nLista.Selected(i) = False
Next n

Os he dejado el código muy comentado para que sea sencillo comprender cómo funciona. Espero que os resulte interesante y os sea de utilidad 🙂

Por supuesto, también está la macro del ejercicio anterior, necesaria para cargar los listbox y hacer las búsquedas.

Por cierto, tanto en este post, como en el anterior, el formulario se abre con el evento Workbook.Open, es decir, en el momento que abrimos el archivo se carga automáticamente el formulario. Es posible que si tenéis activada la seguridad en las macros, en el momento de abrir genere un error. Esto se soluciona guardando el archivo y volviéndolo a abrir, o con un on error resume next (pero no me gusta abusar de este recurso).

Descarga el archivo de ejemplo pulsando en: EXPORTAR DATOS SELECCIONADOS DE UN LISTBOX A OTRO LISTBOX EN OTRO FORMULARIO

CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL

Aunque estoy preparando varios post sobre análisis estadístico de los datos, hoy trataré sobre algo totalmente diferente, los listbox en formularios y la posibilidad de utilizar ADO y las consultas de SQL para buscar y filtrar información.

Vamos seguidamente con un ejemplo para ilustrar el ejercicio. Utilizaré el listado de alumnos que usé para el post de las funciones matriciales, este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL

Y ahora vamos a construir un sencillo formulario en el que vamos a incluir 5 listbox en los que mostraremos la información de la hoja ALUMNOS y también un cuadro de texto (textbox) y un botón de comando para realizar las búsquedas:

Ahora vamos utilizar el siguiente código VBA que vamos a pegar en el evento click del botón de búsqueda, luego lo iremos comentando:

Private Sub CommandButton1_Click()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, MiLibro As String
Dim Control As control, Nombre As String
'Vaciamos todos los Listbox
For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next
'grabamos el dato a buscar, si no hay dato la variable Nombre es nula
Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))
'Creamos la instrucción SQL según los parámetros que nos interesan, en este caso, el nombre
'y los diferentes carácteres comodín y el operador "like"
obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"
'Guardamos el nombre del libro activo para utilizarlo en la conexión ADO
MiLibro = ActiveWorkbook.Name
'Dejamos el cuadro de búsqueda vacío después de iniciar la consulta
Me.TextBox1.Value = vbNullString
'Iniciamos 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
'Pasamos la información a cada ListBox a través del recordset
With UserForm1
.ListBox1.AddItem Dataread("ID")
.ListBox2.AddItem Dataread("NOMBRE")
.ListBox3.AddItem Dataread("CLASE")
.ListBox4.AddItem Dataread("ASIGNATURAS")
.ListBox5.AddItem Dataread("CALIFICACIONES")
End With
Dataread.MoveNext
Loop
'Liberamos y cerramos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Con esta macro podremos realizar consultas a través de lo que indiquemos en el cuadro de búsqueda del formulario (textbox1) o lo que es lo mismo, en la variable “Nombre”.

Pero vamos explicando poco a poco el código. Para borrar o limpiar los datos que van a contener los listbox durante las sucesivas búsquedas tenemos que utilizar el siguiente proceso.

For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next

Una vez que tenemos los listbox libres de datos ya podemos iniciar la consulta SQL:

obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

Me gustaría comentar que aquí utilizamos el dato contenido en la variable “Nombre”, importante para poder utilizar el operador Like y por lo tanto, comodines en nuestra consulta.

Cuando la información del cuadro de texto está vacía, simplemente no mostrará nada en los listbox, eso es porque he introducido mediante una condición que si el dato de búsqueda es vacío, entonces es nulo (y por eso no muestra nada).

Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))

Podríamos quitar la condición y entonces al pulsar “Buscar” y cargaríamos todos los datos en los listbox, pero creo que así es más funcional.

En la parte condicional de la sentencia SQL, estamos indicando mediante el uso de caracteres comodín, que se busquen los nombres que empiecen por la información escrita en el textbox.

"Where [ALUMNOS$].[NOMBRE] like " & "'" & Nombre & "%'"

Por ejemplo, todos los nombre que empiecen por “MA”:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL2

Si queremos extraer los nombres que acaban en “A”, el código sería así:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "'"

Y el resultado este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL3

Y si quisiéramos que se buscase el nombre a partir de cualquier fragmento de texto, simplemente colocaríamos “%” a ambos lados de la variable “Nombre”:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

y podríamos realizar búsquedas más abiertas, por ejemplo, todos los nombres que contengan “AL” (independientemente si está delante, en el centro o al final). Este es el resultado:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL4

Como podéis observar, la clave está en saber utilizar los caracteres comodín correctamente en la sentencia SQL. Es algo sencillo pero hay que tener especial cuidado con la posición de las comillas simples y los espacios.

Por último, 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.

En el archivo de descarga, la búsqueda de los nombres está condicionada a que contengan parte del dato contenido en el buscador.

Descarga el archivo de ejemplo pulsando en: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL

SELECCIONAR ITEMS DE UN COMBOBOX MEDIANTE UN COMANDO DE BOTÓN

Recientemente recibí varias consultas relativas a formularios por parte de un lector. Una de ellas me pareció interesante y hoy voy a comentarla. Se trata de la posibilidad de mediante dos botones mover el contenido que hemos cargado en un control combobox.

Normalmente, cuando cargamos un combo, la información la consultamos abriendo el desplegable y seleccionando el ítem que nos interesa, pero en este caso, la información la veremos a través de dos botones, uno que permita ir hacia delante y otro hacia atrás, mostrando un ítem con cada clic.

Imaginemos que tenemos un combobox  y que lo hemos rellenado con la información que tenemos en la primera columna de la hoja “DATOS” de nuestro archivo (para este ejemplo caso son los departamentos de la empresa que me inventé para el post de los organigramas en SmartArt).

A ese userform le vamos a agregar dos botones (Atrás y Adelante), de forma que cuando inicialicemos nuestro form aparecerá lo siguiente:

SELECCIONAR ITEMS COMBOBOX MEDIANTE BOTONES

Ahora ya podemos ir al código:

Para cargar los datos en el combobox (hay muchas formas de hacerlo, esta es la que suelo utilizar).

Private Sub UserForm_Initialize()
With Sheets("DATOS")
Fin = Application.CountA(.Range("A:A"))
ComboBox1.List = .Range("A2:A" & Fin).Value
End With
End Sub

Ahora que tenemos los datos en el combo, usamos la siguiente macro para el botón “ATRÁS”:

Private Sub CommandButton1_Click()
ComboBox1.SetFocus
SendKeys "{Up}"
End Sub

Y esta otra macro para el botón “ADELANTE”.

Private Sub CommandButton2_Click()
ComboBox1.SetFocus
SendKeys "{Down}"
End Sub

Como podéis ver, simplemente aplico el foco en el Combobox1 y luego con SendKeys utilizo las teclas del teclado de arriba y abajo, consiguiendo así que los ítems de nuestro combo vayan apareciendo a medida que pulso en los botones.

Aunque no es frecuente realizar este tipo de programación, sí puede surgir en algún momento la necesidad, prueba de ello es la propia consulta del lector.

Descarga el archivo de ejemplo pulsando en: SELECCIONAR ITEMS DE UN COMBOBOX MEDIANTE UN COMANDO DE BOTÓN

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

 

GESTIÓN DE CLIENTES (modificaciones)

Ya hace varios años que publiqué un pequeño programa realizado en Excel con motivo de emular las bases de datos de Access y reclamar también así las posibilidades que ofrece Excel para confeccionar este tipo de trabajos: GESTIÓN DE CLIENTES

El motivo de la actualización de hoy, no se debe a mejoras en el programa (que se podrían realizar, pero con tiempo suficiente) , sino a varias consultas y peticiones realizadas por los lectores en cuanto a la necesidad de completar todos los datos que se piden al dar de alta a un cliente. Es decir, que muchos lectores, necesitan que sea posible dar de alta a un cliente sin tener que grabar los datos relativos a su dirección o contacto, de modo que así puedan realizar esta tarea mucho más rápida.

En mi opinión personal y desde el ámbito de la información y las bases de datos, siempre consideraré que es fundamental contar con la máxima cantidad de información. Y esto es fundamental, con ello conseguiremos una base de datos de calidad, fiable y útil. El dar de alta a un cliente sin una dirección asociada o sin un teléfono móvil, puede provocar que cuando necesitemos ponernos en contacto con él no lo podamos hacer, cosa que se habría solucionado perdiendo unos minutos en la toda de datos, por eso en el formulario GESTIÓN DE CLIENTES esta información es obligatoria.

Dicho esto, también tengo en cuenta que en ciertos momentos, no se dispone de dicha información o el cliente no quiere facilitarla, y siempre será mejor dejar un dato en blanco que inventarlo.

Por ello dejo aquí otra versión donde solo se pide de forma obligatoria los datos personales, pudiendo dejar sin rellenar el resto de datos (direcciones y teléfonos). De todas formas, os invito a que siempre intentéis dar de alta todos los datos que podías de vuestros contactos.

Otra mejora que he introducido en este formulario ha sido implementar el buscador de nombres. Es algo sencillo, simplemente he agregado un listbox que se carga cada vez que se pasa el cursor del ratón por encima y para buscar el nombre basta con teclear la primera letra y mostrará los resultados, luego solo hay que seleccionarlo y pulsar en “Buscar”.

También recordar que el formulario está completamente abierto, y si cualquier usuario desea realizar nuevas modificaciones o actualizaciones puede hacerlo fácilmente entrado en el código.

 

Descarga el archivo pulsando enGESTION DE CLIENTES