MOSTRAR INFORMACIÓN DEL SISTEMA DESDE EXCEL CON VBA

Hola a todos:

Casi siempre suelo contestar a todos los correos que me envíais en un tiempo razonable, pero en algunas ocasiones puedo retrasarme, los motivos son muy variables, desde que no dispongo de tiempo, que se me pasó el correo, o que vuestra consulta llegó por error a la carpeta de spam del buzón de la web, en esos casos, lo siento.

No obstante, aunque el correo sea de hace tiempo, suelo contestar y ponerme en contacto con la persona que me ha enviado la consulta.

Hoy es uno de esos casos (correo en spam de la web), y la pregunta era bastante sencilla, el lector quería saber si existía algún procedimiento para poder invocar/mostrar la ventana de información del sistema desde Excel.

No se trata de mostrar la información en excel sino mostrarla en windows abriendo la ventana desde Excel.

Una macro que nos puede venir muy bien es esta, donde directamente ejecutamos un .exe para mostrar la información del sistema con la función “Shell”

Sub Info_sistem()
Dim sistema As Long
sistema = Shell("C:\Program Files\Common Files\Microsoft Shared\MSINFO\MSINFO32.EXE", vbMaximizedFocus)
End Sub

Si esta información la tenéis en otra ubicación o recibe otra denominación, solo tenéis que buscarla en vuestro sistema y sustituir la cadena de conexión.

El resultado es el siguiente:

MOSTRAR INFORMACION DEL SISTEMA DESDE EXCEL CON VBA

Como podéis observar he eliminado alguna información de mi sistema para no hacer datos públicos. Pero cuando lo ejecutéis en vuestro equipo tendréis toda la información disponible.

Y esto es todo, espero que este sencillo código os pueda ayudar.

Y de nuevo perdonad si tardo más de la cuenta en contestar a vuestras consultas : )

¿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

BLOQUEAR EQUIPO DESDE EXCEL USANDO VBA

Hola a todos, ¿qué tal estáis?.

Ayer por la noche un lector me preguntaba cómo podría incluir un botón de comando en su hoja Excel para poder bloquear su equipo cada vez que lo pulsase. Al parecer, la mayor parte del tiempo de su jornada laboral tiene que estar controlando un cuadro de mando realizado en Excel y en muchas ocasiones cuando se ausenta de su puesto de trabajo debe dejar el equipo bloqueado (al instante) pulsando control + alt + supr y luego indicar “bloquear” y por eso quiere que con solo pulsar un botón lo haga.

Esto se puede realizar también con Excel, en concreto utilizando la función LockWorkStation y programando en VBA. Es bastante sencillo de realizar y basta con unas pocas líneas de código.

La forma más sencilla de hacerlo es así:

Declare Function LockWorkStation Lib "user32.dll" () As Long
Sub Bloquear_equipo()
LockWorkStation
End Sub

En efecto, declaramos la función haciendo referencia a la librería y luego lo ejecutamos en un procedimiento Sub.

Obviamente, podemos incluir una multitud de tareas o modificaciones, por ejemplo llamando a la función desde ThisWorkBook en cualquiera de los eventos predefinidos, por ejemplo cuando cambiemos de hoja, cuando el libro no esté activo, etc.

Es un código muy simple, pero en algunas circunstancias puede ser interesante, sobre todo cuando desarrollamos nuestro trabajo utilizando la misma hoja o el mismo libro durante mucho tiempo.

También se podría incluir otra línea de código que además de bloquear el equipo, antes realice una copia de seguridad de nuestro archivo. Pero esa parte os la dejo a vosotros para que vayáis investigando poco a poco : )

Espero que os haya resultado de utilidad!.

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

OCULTAR ICONOS DE FILTRO EN TABLAS DINÁMICAS

Hola a todos!, ¿qué tal estáis?

Hoy publicaré un post muy breve dando contestación a un lector que me preguntaba cómo podía ocultar los iconos de filtro que aparecen una tabla dinámica. Esto es útil si usamos nuestro excel como un documento a modo de presentación y queremos ocultar el aspecto de la tabla dinámica, o impedir que se puede volver a filtrar o desfiltrar los datos de una tabla.

Veamos un ejemplo sencillo con una tabla dinámica:

OCULTAR ICONOS DE FILTRO EN TABLAS DINAMICAS

Para poder eliminar los iconos de filtro es necesario utilizar una macro, es este caso la rutina realiza los cambios en todas las tablas que se encuentren en el libro.

Sub oculta_filtro()
'Declaramos variables
Dim Hoja As Worksheet
Dim Tabla_d As PivotTable
Dim Campo As PivotField
'Recorremos todos los libros y las hojas
For Each Hoja In ActiveWorkbook.Sheets
For Each Tabla_d In Hoja.PivotTables
For Each Campo In Tabla_d.PivotFields
'Desactivamos la selección de los items
Campo.EnableItemSelection = False
Next
Next Tabla_d
Next Hoja
End Sub

El resultado será el siguiente:

OCULTAR ICONOS DE FILTRO EN TABLAS DINAMICAS1

Como podéis comprobar hemos eliminado sin problema los iconos del filtro en la tabla. Para volver a ponerlos solo es necesario cambiar en el código = False por = True

Y eso es todo, espero que os resulte de utilidad.

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

CRUZAR DOS TABLAS EN EXCEL USANDO SQL

Hola a todos!

Hace tiempo que no escribía una entrada, pero estos últimos días he estado bastante mal debido a una gastroenteritis que me ha dejado destrozado, y aún sigo en recuperación.

Aún así, he querido sacar tiempo para escribir un nuevo post. Esta vez me gustaría hablar sobre el cruce de archivos, algo tan corriente en Excel como el uso de función buscarv. Y es que realmente, lo que se pretende hacer cuando se cruzan archivos es buscar un valor y determinar si está o no en esa base de datos.

Existe una forma un poco más elaborada para realizar esta tarea, muy útil para trabajar con procesos definidos y con la misma estructura de datos. Por ejemplo, imaginad que tenéis la información de los empleados de unos grandes almacenes en dos momentos distintos, uno anterior y otro actual:

CRUZAR DOS TABLAS EN EXCEL USANDO SQL

Y ahora lo que queremos saber es, qué empleados están en la base de datos anterior y no en la actual (Bajas), y viceversa, es decir, (Altas). Estas dos consultas se puede realizar con SQL utilizando ADO:

Para las Altas:

obSQL = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'NUEVO EMPLEADO' AS ESTADO " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ANTERIOR$].[ID]) IS NULL)"

Para las Bajas:

obSQL = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA' " & _
"FROM [BBDD_ANTERIOR$] LEFT JOIN [BBDD_ACTUAL$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ACTUAL$].[ID]) IS NULL)"

Efectivamente, con estos códigos podemos extraer la información requerida. Pero imaginad que queremos obtener los movimientos que han sucedido entre “Secciones”, es decir qué empleados han dejado una sección y qué empleados han entrado en una nueva sección. Obviamente, los empleados son los mismos, lo único que cambia es la sección.

Para ello, solo debemos modificar levemente el código:

Altas en una sección:

obSQL = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'ALTA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ACTUAL$].[SECCION]) NOT LIKE [BBDD_ANTERIOR$].[SECCION] "

Bajas en una sección:

obSQL = "SELECT [BBDD_ANTERIOR$].[ID], [BBDD_ANTERIOR$].[NOMBRE COMPLETO], [BBDD_ANTERIOR$].[SECCION], 'BAJA SECCION' " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE([BBDD_ANTERIOR$].[SECCION]) NOT LIKE [BBDD_ACTUAL$].[SECCION] "

Estos fragmentos de código solo son la consulta SQL específica. Para que funcione es necesario embeberla en entorno VBA. Os dejo aquí la primera de las cuatro consultas, no reproduciré el resto dado que ya las podéis ver en el archivo de descarga.

Sub ALTA()
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, fin As Integer, milibro As String
Application.ScreenUpdating = False
fin = Application.CountA(Sheets("MOVIMIENTOS").Range("A:A"))
'Borramos datos de consultas anteriores
If fin > 0 Then Sheets("MOVIMIENTOS").Range("A1:D" & fin).Clear
'indicamos los parámetros de la consulta SQL
obSQL = "SELECT [BBDD_ACTUAL$].[ID], [BBDD_ACTUAL$].[NOMBRE COMPLETO], [BBDD_ACTUAL$].[SECCION], 'NUEVO EMPLEADO' AS ESTADO " & _
"FROM [BBDD_ACTUAL$] LEFT JOIN [BBDD_ANTERIOR$] ON [BBDD_ACTUAL$].[ID] = [BBDD_ANTERIOR$].[ID]" & _
"WHERE(([BBDD_ANTERIOR$].[ID]) IS NULL)"
'Obtenemos el nombre del libro
milibro = ThisWorkbook.Name
'Creamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & milibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
Dataread.MoveFirst
'pasamos información a la hoja movimientos
With Worksheets("MOVIMIENTOS")
.Cells(2, 1).CopyFromRecordset Dataread
'mostramos encabezados
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
.Cells(1, i + 1) = dfecha
Next
End With
Loop
'ejecutamos el resto de consultas
Call BAJA
Call ALTA_SECCION
Call BAJA_SECCION
Set Dataread = Nothing
Set cnn = Nothing
End Sub

Como podéis observar, después de ejecutar la primera consulta, ejecutamos el resto de consultas en el mismo proceso.

El resultado de ejecutar el código es el siguiente:

CRUZAR DOS TABLAS EN EXCEL USANDO SQL_1

Y ya tenemos un resumen detallado de los nuevos empleados, las bajas producidas y los cambios de sección (anterior y actual).

Aunque es un proceso un poco largo, si se trata de consultas que siempre tendrán la misma estructura y periodicidad, es el método adecuado. Resulta también muy interesante además su uso conjunto con Access o archivos de texto (sería necesario realizar cambios en la programación).

Os recuerdo que es necesario marcar la referencia Microsoft ActiveX Data Object 2.8 Library (o la que corresponda) para que todos los componentes funcionen correctamente.

Para poder generar los nombres y confeccionar vuestras propias bases de datos os remito al siguiente post

Descarga el archivo de ejemplo pulsando en: CRUZAR DOS TABLAS EN EXCEL USANDO SQL

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

ACTUALIZAR TODAS LAS TABLAS DINÁMICAS DE UN LIBRO

Hola a todos!:

Hace unos días un lector me preguntaba acerca de cómo podía actualizar todas las tablas dinámicas que tenía en su libro de trabajo. Para poder hacer esto es necesario realizar una sencilla macro que recorra todas las hojas de nuestro libro y en el momento que detecte una tabla dinámica, la actualice o la refresque.

La macro que vamos a utilizar es la siguiente:

Sub Actualiza_Todas_Tabla()
'Declaramos variables
Dim nHojas As Worksheet
Dim tDinamica As PivotTable
'Recorremos todas las hojas
For Each nHojas In ThisWorkbook.Worksheets
'Recorremos todas las tablas de cada hoja
For Each tDinamica In nHojas.PivotTables
'Refrescamos
tDinamica.RefreshTable
Next tDinamica
Next
End Sub

Como podéis comprobar en los comentarios de la macro se realiza la tarea requerida.

A continuación, este lector me solicitaba lo mismo para condicionando solo algunas de las tablas dinámicas para ser actualizadas, por ejemplo que solo actualice la tabla dinámica 1:

Sub Actualiza_Tabla()
'Declaramos variables
Dim nHojas As Worksheet
Dim tDinamica As PivotTable
'Recorremos todas las hojas
For Each nHojas In ThisWorkbook.Worksheets
'Recorremos todas las tablas de cada hoja
For Each tDinamica In nHojas.PivotTables
'Si la tabla se llama TablaDinámica1 entonces refrescamos esa tabla.
If tDinamica.Name = "TablaDinámica1" Then tDinamica.RefreshTable
Next tDinamica
Next
End Sub

Y eso es todo, ha sido un post muy breve, pero seguro que os resulta de utilidad en vuestros proyectos.

🙂

EXTRAER INFORMACIÓN DE UNA CADENA ALFANUMÉRICA EN FUNCIÓN DE VARIOS CRITERIOS

Hola a todos!, ¿qué tal estáis?, espero que muy bien.

Hace tiempo, desarrollé una macro que permitía extraer determinados caracteres de una cadena de texto y utilizar la función “texto en columna” programada en VBA para mostrar la información: EXTRAER INFORMACIÓN ESPECÍFICA DE UNA CADENA ALFANUMÉRICA UTILIZANDO TEXTO EN COLUMNAS

Pues bien, hoy me ha llegado una consulta en la que me solicitaban modificar la macro para poder extraer en una cadena de texto, de dos en dos caracteres, según un número de veces indicado en una columna.

Es decir, imaginad que tenéis en una celda esta cadena de número y letras: 57e87d54222 y en una columna se especifica el número 4, por lo que hemos de extraer de dos en dos los cuatro primeros pares, así: 57 e8 7d 54

Aunque pueda parecer algo poco común, en realidad lo es, porque muchas veces la información se almacena en un cadena (de texto o numérica, o ámbas) y luego es necesario extraerla de alguna forma.

En fin, que lo mejor es ver la macro donde explico cómo lo hago:

Option Explicit
Sub Extrae_Varios()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer, fin As Integer
Dim nCampos As Integer, n_Colum As Integer, nCasos As Integer
Dim nCadena As String, sCadena As String
Dim miArray As Variant, iArray As Variant
'Iniciamos la macro
With Sheets("DATOS")
Application.ScreenUpdating = False
fin = Application.CountA(.Range("A:A"))
'Borramos información a partir de la columna "C"
.Range(.Cells(2, 3), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Iniciamos bucle para recorrer todas las filas
For j = 2 To fin
'Seleccionamos numero de casos y cadena de texto
sCadena = .Cells(j, 2)
nCasos = .Cells(j, 1) * 2
'componemos nueva cadena de dos en dos
For i = 1 To nCasos Step 2
nCadena = nCadena & " " & Mid(sCadena, i, 2)
Next
'Eliminamos espacios en blanco al principio
.Cells(j, 3) = Trim(nCadena)
'Dimensionamos matrices con los datos que tenemos
'para determinar las columnas de la función textToColumns
nCampos = Len(.Cells(j, 3))
nCampos = nCampos - 1
ReDim miArray(0 To nCampos)
For n_Colum = 0 To nCampos
ReDim iArray(0 To 1)
iArray(0) = n_Colum + 1
iArray(1) = 1
miArray(n_Colum) = iArray
Next n_Colum
'Aplicamos la función texto en columnas a partir de la segunda columna
'delimitamos el texto en caracteres (en este ejemplo utilizamos los espacios).
Cells(j, 3).TextToColumns Destination:=Range("C" & j), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=miArray
'Indicamos que todas las matrices tengan formato general, pero podríamos indicar que sea número, etc
nCadena = vbNullString
Next
.Cells(j, 1).Select
End With
End Sub

El resultado de la macro es el siguiente:

EXTRAER INFORMACIÓN DE UNA CADENA ALFANUMÉRICA EN FUNCIÓN DE VARIOS CRITERIOS

Como podéis observar, extraemos la información de dos en dos y colocamos cada par en una celda diferente.  Si necesitáis incrementar a tres, cuatro, etc, solo tenéis que modificar la macro y lo tendréis resuelto.

Descarga el archivo de ejemplo pulsando en: EXTRAER INFORMACIÓN DE UNA CADENA ALFANUMÉRICA EN FUNCIÓN DE VARIOS CRITERIOS

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

Hola todos!

Hace unos meses publiqué un post acerca de la generación de números aleatorios sin duplicados:  OBTENER NÚMEROS ALEATORIOS SIN DUPLICADOS

El código funciona perfectamente y muchos lectores lo han descargado para usarlo en sus aplicaciones. Sin embargo, ayer un usuario me consultaba si podría modificarlo para generar una cadena alfanumérica aleatoria sin duplicados.

La respuesta es que sí, veamos el código y las modificaciones realizadas:

Option Explicit
Sub OBTENER_CADENA_ALEATORIOS_UNICOS()
'Declaramos variables
Dim oDic As Object, palabra As Variant
Dim Micelda As String, matrix1 As Variant, matrix2 As Variant
Dim sCadena As String, i As Integer, unicos As String
Dim j As Integer, nNum As Double, fin As Integer
Dim nLetU As String, nLetL As String, nItem As Variant, nCombo As Integer
With Sheets("Hoja1")
'eliminamos información generada en la consulta anterior.
fin = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Rows.Count
.Range("A2:A" & 2 + fin).ClearContents
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Ejecutamos loop hasta el total de números y letras que queremos obtener
Do Until j = .Cells(2, 6)
'generamos aleatorios entre 1 y 50
nNum = Application.WorksheetFunction.RandBetween(.Cells(4, 6), .Cells(4, 7))
'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 hoja1
matrix2 = Split(sCadena, " ")
For j = 0 To UBound(matrix2)
.Cells(j + 2, 1) = matrix2(j)
Next j
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Sub

Para poder generar aleatorios de letras, necesitamos recurrir a los caracteres ASCII, en concreto vamos a utilizar los que van desde el 65 al 90, que comprenden el abecedario en mayúsculas. Luego solo tenemos que introducir la función aleatorio.entre y tendremos una variable que generará una letra de forma aleatoria cada vez que se ejecute el código:

nLetU = Chr((Application.WorksheetFunction.RandBetween(65, 90)))

Para realizar lo mismo en minúsculas, solo tenemos que transformar esta información con LCase:

nLetL = LCase(Chr((Application.WorksheetFunction.RandBetween(65, 90))))

Luego, con un pequeño condicional y otra variable aleatoria entre 1 y 3, iremos componiendo nuestra cadena alfanumérica aleatoriamente, y con el objeto dictionary eliminaremos los duplicados.

El resultado, por ejemplo, generando una cadena de 25 caracteres con números comprendidos del 1 al 9, sería este:

GENERAR CADENA DE CARACTERES ALFANUMERICOS ALEATORIOS SIN DUPLICADOS

Como podéis observar la información se obtiene perfectamente. Aunque es obvio, lo comentaré, las letras mayúsculas y minúsculas se tratan como si fuesen caracteres diferentes, por ello pueden existir tanto una “M” mayúscula como una “m” minúscula.

Y eso es todo, espero que resulte de utilidad : )

Descarga el archivo de ejemplo pulsando en: GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

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

Donate Button with Credit Cards

¡¡Muchas gracias!!