MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS

Hola a todos!.

Espero que estéis bien!, hoy os voy a dejar una macro que creé para responder a una consulta.

Se trata de mostrar las propiedades que tiene uno o varios archivos en una hoja, es decir, listarlos y mostrar los datos. Esto ya lo realicé en una ocasión con este post: LISTAR LAS PROPIEDADES DE TODOS LOS ARCHIVOS DE UNA CARPETA Y SUBCARPETAS

Pero a diferencia del post anterior, lo que necesita el lector es que pueda seleccionar los archivos y no la carpeta con todo su contenido. Esto es algo bastante razonable, así que le mostré una posible solución.

Imaginad que queremos listar estos archivos, pero no todo el contenido de la carpeta, solo los archivos de Excel:

MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS

Pues con este código lo vamos a lograr:

Sub LISTAR_ARCHIVOS()
'Definimos variables
Dim i As Long, j As Long, FSO As Object
Dim nArchivo As String, dir_Archivo As Variant
'Creamos ventana de diálogo para seleccionar los archivos que queremos listar
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS", MultiSelect:=True)
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
With ActiveSheet
'Iniciamos un for con para identificar los archivos seleccionados
'Creamos FileSystemObject para obtener propiedades de cada archivo seleccionado
Set FSO = CreateObject("Scripting.FileSystemObject")
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
i = Application.CountA(Range("A:A")) + 1
nArchivo = dir_Archivo(j)
'pasamos el link de cada archivo seleccionado a la hoja
.Cells(i, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=nArchivo, TextToDisplay:=nArchivo
'Pasamos propiedades de cada archivo a la hoja
.Cells(i, 2) = FSO.GetFile(nArchivo).DateCreated
.Cells(i, 3) = FSO.GetFile(nArchivo).DateLastAccessed
.Cells(i, 4) = FSO.GetFile(nArchivo).DateLastModified
.Cells(i, 5) = FSO.GetFile(nArchivo).Type
.Cells(i, 6) = FSO.GetFile(nArchivo).Size
Next j
End With
End Sub

Después de seleccionar los archivos, el resultado es el siguiente:

MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS_1

Como podéis observar, tenemos los archivos seleccionados, con su hipervínculo al lugar del equipo en el que los tenemos y algunas de sus propiedades, tamaño, fecha creación, modificación, etc.

Y eso es todo, espero que os resulte interesante y lo podáis utilizar en vuestros proyectos.

Descarga el archivo de ejemplo pulsando en: MOSTRAR PROPIEDADES DE ARCHIVOS SELECCIONADOS

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

Anuncios

PROGRAMAR HIPERVÍNCULOS EN VBA. EJEMPLO PRÁCTICO CON GOOGLE MAPS

Hola a todos:

Hoy os voy a mostrar una forma de programar hipervínculos que estoy seguro os parecerá interesante. La idea es la de crear un proceso dinámico y automático y no solo conformarnos con invocar el método Hyperlink.

Por ejemplo, se me ocurre que si escribo una serie de lugares en mi hoja Excel y decido crear una ruta de viaje, si seleccionase esas celdas podría mostrar esa información en un navegador (el que tenga definido como predeterminado) con google maps.

Vamos a ver un ejemplo:

PROGRAMAR HIPERVÍNCULOS EN VBA. EJEMPLO PRÁCTICO CON GOOGLE MAPS

Estas son las rutas de viaje que me he propuesto y con las que casi voy a dar la vuelta a España, gran viaje!!

Para poder hacerlo y llevarlo a cabo os mostraré el código que voy a utilizar:

Sub MAPA()
'Declaramos las variables
Dim Matriz As Object, Palabra As Variant, Area As Object
Dim alfaDato As Variant, iPalabra As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Trabajamos con la hoja activa
With ActiveSheet
Set Area = Application.Intersect(Selection, .UsedRange)
'Controlamos que existan datos seleccionados
On Error GoTo Control
'Por cada objeto/palabra del rango seleccionado
For Each Palabra In Area
'Añadimos cada palabra a la matriz con un loop
Matriz.Add Palabra
Next Palabra
'Pasamos los datos a una cadena de texto
For Each alfaDato In Matriz
iPalabra = iPalabra & "/" & alfaDato
Next alfaDato
OrdenarAlfa = Trim(iPalabra)
'Abrimos explorador y mostramos la ruta
Url = "https://www.google.com/maps/dir" & OrdenarAlfa
ActiveWorkbook.FollowHyperlink Url, NewWindow:=False
'mostramos mensaje de error
Control: If Err.Number = "424" Then
MsgBox ("EL RANGO O LAS CELDAS SELECCIONADAS NO CONTIENEN DATOS"), vbExclamation, "SIN DATOS SELECCIONADOS"
End If
'Limpiamos variable de objeto
Set Matriz = Nothing
Set Area = Nothing
End With
End Sub

Como podéis ver, además del método Workbook.FollowHyperlink tambíen he introducido la creación de una cadena y una matriz con los datos seleccionados.

Este método os puede servir para muchos trabajos de programación en Excel y otros lenguajes.

El resultado es este, unas 34 horas de viaje y unos cuantos sitios que visitar : )

PROGRAMAR HIPERVÍNCULOS EN VBA. EJEMPLO PRÁCTICO CON GOOGLE MAPS_1

Este ejercicio es meramente orientativo y para que aprendáis cómo podemos utilizar y programar los hipervínculos en Excel.

Y eso es todo, ¿os parece interesante?.

Descarga el archivo de ejemplo pulsando en: PROGRAMAR HIPERVÍNCULOS EN VBA. EJEMPLO PRÁCTICO CON GOOGLE MAPS

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Hola a todos!:

Estos días estoy más liado de lo normal!, de repente se ha vuelto todo muchas … Intenso!. En fin, hay temporadas más tranquilas y otras con más trabajo, así es la vida.

Pero no por eso voy a dejar de publicar el post semanal de Excel y VBA, verdad?. Esta temporada estoy subiendo muchos vídeos de ejemplo de mis post a LinkedIn para que los usuarios de la red vean cómo funciona realmente un procedimiento o una fórmula.

Hoy quiero compartir una de tantas formas que existen para crear y colocar encabezados en nuestros informes. Desde la igualación de celdas a un valor a un proceso  mediante un loop o igualando un rango a un array.

Este último ejemplo es el que vamos a ver hoy, y es muy sencillo: Imaginad que queréis mostrar siempre este encabezado en la hoja que se esté activa:

COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

Para conseguirlo, lo vamos a hacer con 5 líneas de código:

Sub ENCABEZADOS()
With Range("A1:F1")
.Value = Array("NOMBRE", "APELLIDOS", "EDAD", "ESTUDIOS", "TELÉFONO", "DIRECCIÓN")
.Font.Bold = True
.Font.Color = vbRed
End With
End Sub

Como podéis ver,  no hemos usado una sola variable, simplemente hemos definido el rango y lo igualamos al Array que hemos creado con los nombres que queremos usar como encabezados, la coma es el separador entre los distintos elementos del array.

Para colorear las letras, usamos la propiedad font.color y usando una constante para darle color rojo.

Para dar formato negrita, pasamos propiedad Bold como true.

Ya se que es un post cortito, pero para los que no conocéis este método, estoy seguro que os seré de utilidad en algún momento.

Descarga el archivo de ejemplo pulsando en: COLOCAR ENCABEZADOS CON VBA IGUALANDO UN RANGO A UN ARRAY

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

GENERAR PALETA DE COLORES CON VBA

Hola a todos:

El post de hoy es sobre la paleta de colores que usa Excel y como podemos listar esos colores utilizando VBA.

Para empezar, me gustaría decir que este tema está muy publicado en internet, en particular hay una macro que se encuentra en muchas webs sobre esta temática, ¡¡la misma macro!! lo que indica la nula creatividad de algunos autores a la hora de realizar los post y copiar el código directamente sin molestarse en cambiar ni una línea. Yo plantearé otra forma.

Os mostraré un procedimiento que listará todos los colores de esa paleta, del 1 al 56, el cero no lo tendremos en cuenta, dado que es idéntico al 2 (blanco).

Lo haremos en horizontal y cada 6 celdas, de forma que se verá como una paleta de colores y no una fila hacia abajo …

Lo haremos con este código:

Option Explicit
Sub PALETA_COLOR()
'Definimos variables
Dim CONT As Integer, COL As Integer
Dim i As Integer
'Inicializamos proceso
CONT = 1
COL = 1
'Creamos loop para colorear celda con cada color index
'Cada 6 celdas seguimos el loop en la columna siguiente
For i = 1 To 56
If CONT <= 5 Then
Cells(CONT, COL).Interior.ColorIndex = i
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = CONT + 1
Else
Cells(CONT, COL).Interior.ColorIndex = i
Cells(CONT, COL + 1).Value = "Color: " & i
CONT = 1
COL = COL + 2
End If
Next i
End Sub

La ejecución del código se realiza con un botón de comando y también he añadido otra sencilla macro para limpiar el rango:

Sub LIMP()
Dim CELDA As Variant
'Limpiamos datos en rango
With ActiveSheet
For Each CELDA In .Range("A1:T6")
CELDA.Clear
Next CELDA
End With
End Sub

Este es el resultado de ejecutar nuestro código:

GENERAR PALETA DE COLORES CON VBA

Si quisiéramos seguir con el loop en la columna siguiente cada 15 celdas, por ejemplo, solo tendríamos que cambiar el número en esta línea de código:

If CONT <= 5 Then

a

If CONT <= 14 Then

Como véis es una macro muy sencilla y visual, y también podéis comprobar como se pueden exponer temas muy tratados en las webs especializadas sobre vba y excel y ser un poco original a la par de evitar el copiar códigos ajenos : ).

Descarga el archivo de ejemplo pulsando en: GENERAR PALETA DE COLORES CON VBA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓN

Hola a todos:

Hoy me gustaría tratar otra vez el tema de las cadenas alfanuméricas sin duplicados, es decir con caracteres únicos, no repetidos.

Esto es un tema que ya he publicado varias veces en esta web, en concreto hoy voy a tratar sobre este post: GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

A nivel teórico no vamos a crear nada nuevo, pero sí a nivel práctico, dado que vamos a pasar el proceso que en el post os mostraba con una macro (y su botón de ejecución) a ser realizado con una función.

Podéis consultar la macro accediendo al post que os he dejado y aquí os voy a dejar el mismo código pero modificado para ser una función:

Option Explicit
Function CADENA_UNICOS(ByVal LARGO As Long, MIN As Long, MAX As Long)
'Declaramos variables
Dim oDic As Object
Dim Micelda As String, matrix1 As Variant, matrix2 As Variant
Dim sCadena As String, i As Long, unicos As String
Dim j As Long, nNum As Double
Dim nLetU As String, nLetL As String, nItem As Variant, nCombo As Integer
With Sheets("Hoja1")
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Ejecutamos loop hasta el total de números y letras que queremos obtener
Do Until j = LARGO
'generamos aleatorios entre lo que indiquemos
nNum = Application.WorksheetFunction.RandBetween(MIN, MAX)
'generamos aleatorio de letras mayúsculas
nLetU = Chr((Application.WorksheetFunction.RandBetween(65, 90)))
'generamos aleatorio de letras minúsculas
nLetL = LCase(Chr((Application.WorksheetFunction.RandBetween(65, 90))))
'determinamos aleatoriamente qué elemento seleccionamos para pasar a la cadena
nCombo = Application.WorksheetFunction.RandBetween(1, 3)
If nCombo = 1 Then
nItem = nNum
ElseIf nCombo = 2 Then
nItem = nLetU
ElseIf nCombo = 3 Then
nItem = nLetL
End If
'componemos string con los números y letras que vamos generando
Micelda = Micelda & " " & nItem
matrix1 = Split(Micelda, " ")
'Eliminamos números y letras repetidos
For i = 0 To UBound(matrix1)
If Not oDic.Exists(matrix1(i)) Then oDic.Add matrix1(i), matrix1(i)
Next i
'Creamos una nueva cadena sin duplicados y seguimos el loop
unicos = Join(oDic.Keys, " ")
sCadena = Trim(unicos)
matrix2 = Split(sCadena, " ")
'contamos los números y letras aleatorios únicos que vamos generando
j = UBound(matrix2) + 1
Loop
'Pasamos los datos a la función
CADENA_UNICOS = sCadena
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Function

Es prácticamente igual a la macro, pero hay que tener en cuenta los parámetros, que ahora los vamos a seleccionar directamente desde la función.

Sus parámetros son (sin comillas):

LARGO: es la longitud que deseamos dar a nuestra cadena.
MIN y MAX: se trata del rango mínimo y máximo con el que se generará la función aleatorio.entre.

En este caso, queremos un largo de 10 caracteres (no cuentan los blancos),  y números entre el 1 y el 9:

CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓN

Y de esta forma tenemos el resultado de la función en una celda y según lo especificado.

Un dato importante, si el número que indicamos en el argumento “LARGO” es mucho mayor a MAX, es posible que la función no responda, dado que se puede producir que estemos buscando una cadena de números aleatorios más alta de los que podemos generar según los parámetros.

Por ejemplo, si estuviésemos trabajando solo con una cadena numérica y especificásemos un largo de 10 y usar números de 1 a 9, la aplicación se bloqueará en un bucle sin fin. En esta macro, esto no se produce con esa claridad, dado que introducimos letras, y por lo tanto no se puede realizar un control. Por ello, tratad de indicar el argumento MAX mayor que LARGO.

Los números o caracteres aleatorios están separados por un espacio, que no se cuenta pero sirve como separador.

Como siempre, os dejo el ejemplo:

Descarga el archivo de ejemplo pulsando en: CREAR CADENA ALFANUMÉRICA SIN DUPLICADOS CON UNA FUNCIÓ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!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

Hola a todos:

Como podéis comprobar, estos últimos post que estoy subiendo a la web están muy relacionados con las UDF (funciones definidas por el usuario). Y es que precisamente el poder definir nuestras propias funciones es lo que nos permite realizar nuestro trabajo con mayor facilidad.

Muchas veces recibo consultas de cómo hacer determinados procesos o cómo programar un evento específico. Hoy os dejo un ejemplo de una de esas consultas:

“Hola Segu. Tengo una tabla de datos la cual consta de varias columnas con diferentes marcas, y en las filas tengo códigos únicos, lo que deseo hacer es que de alguna manera colocar el código único en una celda fuera de la tabla, y que me retorne la o las marcas que tiene ese código, es decir en donde la función encuentre el número uno, entonces colocar el nombre de la marca que se encuentra en el encabezado.”

Efectivamente, lo que vamos a realizar se puede ver perfectamente en el ejemplo que me envió:

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

Como podéis comprobar, se trata de rellenar el dato en las celdas B7,B8 y B9 con las “Marcas” de la fila 1 siempre que el código tenga un “1” asignado en rango horizontal.

Para poder hacerlo tal y como lo necesita el lector, usaremos la siguiente UDF:

Option Explicit
Function BUSCA_REF(ByVal DATO_BUSCADO As Variant, RANGO_BUSQUEDA As Range, RANGO_HORIZONTAL As Range, PARAMETRO As String)
'Declaramos variables
Dim HOJA As String, CELDAV As Object, CELDAH As Object, CELDA_ACTUAL As String, RANGO_ACTUAL As Range
Dim FILA As String, nCOLUMN As String, DATO As String, CONT As Long
'Capturamos la hoja en la que se encuentra el rango de búsqueda
HOJA = RANGO_BUSQUEDA.Parent.Name
'Buscamos el dato seleccionado en el rango de búsqueda
For Each CELDAV In RANGO_BUSQUEDA
'Si coincide entonces
If UCase(CELDAV) = UCase(DATO_BUSCADO) Then
'obtenemos el número de celda en el que nos encontramos
CELDA_ACTUAL = Replace(Split(CELDAV.Address, "$")(2), ":", "")
'Componemos nuevo rango horizontal a buscar
Set RANGO_ACTUAL = Sheets(HOJA).Range(Replace(Split(RANGO_HORIZONTAL.Address, "$")(1), ":", "") & CELDA_ACTUAL & ":" & Replace(Split(RANGO_HORIZONTAL.Address, "$")(3), ":", "") & CELDA_ACTUAL)
'Buscamos en el rango horizontal
For Each CELDAH In RANGO_ACTUAL
'Si encontramos el valor igual al parámetro (en este ejemplo "1")
If CELDAH = PARAMETRO Then
'Seleccionamos el encabezado de la hoja
'compuesto por el número de fila y letra de columna actual
FILA = Replace(Split(RANGO_HORIZONTAL.Address, "$")(2), ":", "")
nCOLUMN = Replace(Split(CELDAH.Address, "$")(1), ":", "")
DATO = DATO & " " & Sheets(HOJA).Range(nCOLUMN & FILA)
End If
Next CELDAH
CONT = CONT + 1
End If
Next CELDAV
'Pasamos resultado a la función
'si el valor buscado no existe pasamos un error
If CONT = 0 Then
BUSCA_REF = "#N/A"
Else
'si existe pero no tiene el parámetro buscado pasamos un 0, sino el dato
BUSCA_REF = IIf(DATO = vbNullString, 0, DATO)
End If
End Function

Como siempre el código lo he comentado muy detalladamente para que no tengáis dudas. Por supuesto, este trabajo lo podemos hacer también con código en una macro sin utilizar una función, pero el lector prefería que fuese una UDF.

La función está habilitada para funcionar en distintas hojas y se actualiza con cada cambio.

Los parámetros a tener en cuenta son:

  • El DATO_BUSCADO: el dato que queremos buscar en la matriz.
  • El RANGO_BUSQUEDA: el rango vertical en el que se encuentra el código a buscar.
  • El RANGO_HORIZONTAL: es la selección de todo el rango, tanto encabezados como las celdas con información.
  • PARÁMETRO: es el parámetro sobre el que basamos la búsqueda, por ejemplo “1”. Entre comillas dobles.

Aquí podéis ver la fórmula aplicada:

EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA_1

Y esto es todo, aquí podéis ver el ejemplo de cómo creando nuestra propia función podemos obtener lo que necesitamos.

Descarga el archivo de ejemplo pulsando en: EJEMPLO PRÁCTICO DE UNA UDF PARA RESOLVER UNA TAREA ESPECÍFICA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

Hola a todos!.

¿Qué tal estáis?, espero que bien.

Hoy voy a publicar una función muy sencilla que nos va a ayudar a eliminar las tildes de las palabras que hayamos seleccionado.

Cuando cruzamos datos, en muchas ocasiones tenemos problemas a la hora de determinar coincidencias cuando en una palabra tenemos una tilde y en otra no.

Para solucionar este problema acabo de crear una función, se llamará SIN_TILDES.

Este es el código que utilizaremos:

Function SIN_TILDE(ByVal Rango As String)
'Reemplazamos tildes en vocales minúsculas
Rango = Replace(Rango, "á", "a")
Rango = Replace(Rango, "é", "e")
Rango = Replace(Rango, "í", "i")
Rango = Replace(Rango, "ó", "o")
Rango = Replace(Rango, "ú", "u")
'Reemplazamos tildes en vocales mayúsculas
Rango = Replace(Rango, "Á", "A")
Rango = Replace(Rango, "É", "E")
Rango = Replace(Rango, "Í", "I")
Rango = Replace(Rango, "Ó", "O")
Rango = Replace(Rango, "Ú", "U")
SIN_TILDE = Rango
End Function

Como podéis observar, es muy sencilla y básicamente programamos la función Replace() para poder eliminar las tildes en las palabras.

Por ejemplo:

FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

No hay mucho más que explicar … obviamente, la podéis combinar con buscarv y otras funciones.

Y esto es todo, espero que os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA ELIMINAR TILDES EN CELDA SELECCIONADA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies