SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO

Hola a todos:

Cuando creamos procesos o programamos siempre lo hacemos pensando en nuestras necesidades y la mejor adaptación a las mismas.

En el post de hoy voy a plantear la siguiente situación, imaginad que tenéis que pasar una serie de informaciones de manera periódica a un directorio, pero no es un archivo, ni una hoja, sino que cada dos hojas debemos generar un archivo y guardarlo en una carpeta determinada.

Por ejemplo, este sería el archivo, como podéis ver tenemos por cada informe un detalle de info, es decir, debemos guardar 4 archivos de dos pestañas cada uno:

SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO_1

Esto se puede resolver de distintas formas, hoy os propongo un ejemplo utilizando un array para seleccionar las 2 hojas.

La macro que vamos a usar es la siguiente:

Option Explicit
Sub CADA_N_HOJA()
'Declaramos variables
Dim dir_Archivo As Variant, Directorio As String
Dim Fin As Long, Cnt As Long, i As Long, Hoja As String, Hoja_n As String
'Seleccionamos carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Obtenemos ruta a la carpeta
Directorio = dir_Archivo.SelectedItems(1)
'Contamos el número de hojas de nuestro archivo
Fin = ThisWorkbook.Sheets.Count
'Creamos un contador
Cnt = 1
'Recorremos las hojas
For i = 1 To Fin Step 2
Cnt = i + 1
'Creamos dos variables para obtener el nombre de cada hoja
Hoja = Worksheets(i).Name
Hoja_n = Worksheets(Cnt).Name
'Pasamos las variables a un array
'Y seleccionamos y pegamos las hojas de 2 en 2
Sheets(Array(Hoja, Hoja_n)).Select
Sheets(Array(Hoja, Hoja_n)).Copy
'Guardamos los archivos creados.
ActiveWorkbook.SaveAs Filename:=Directorio & "\" & Hoja
'Cerramos el archivo después de guardarlo
ActiveWorkbook.Close
Next i
End Sub

Estamos usando un for para asignar a la variable “i” la primera hoja/pestaña a seleccionar y un contador (Cnt) para seleccionar la segunda hoja. Dado que las hojas se pueden nombrar, es importante extraer el nombre de la hoja (con el objeto Name), lo que nos va a permitir especificar en el array el nombre de la hoja que debemos seleccionar.

Una vez que hemos seleccionado las hojas, las copiamos y las guardamos en el directorio/carpeta que hemos indicado al principio de la macro.

El resultado es el siguiente:

Como podéis observar, la macro hace lo esperado, selecciona cada dos hojas y las guarda en la carpeta que hayamos seleccionado.

No he incluido ningún botón para ejecutar la macro, lo podéis hacer directamente desde el editor de VBA.

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

Descarga el archivo de ejemplo pulsando en: SELECCIONAR DE DOS EN DOS HOJAS Y GUARDARLAS EN UN DIRECTORIO DETERMINADO

¿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

CAPTURAR PANTALLA DE UNA HOJA DE EXCEL CON VBA

Hola a todos!:

Como respuesta a una consulta, hoy os mostraré un método distinto para realizar una captura de pantalla de la hoja en la que nos encontramos.

Este método no tiene nada que ver con la funcionalidad de CAPTURA DE PANTALLA que nos encontramos en nuestra cinta de opciones de Excel. Este método utiliza la combinación de teclas para crear capturar la pantalla en la que nos encontramos.

El código es el siguiente:

Option Explicit
Sub CAPTURA_PANT()
Dim Shape As Excel.shapes
Dim shapes As Variant
'Por cada forma en la hoja activa
Application.ScreenUpdating = False
For Each shapes In ActiveSheet.shapes
' Eliminamos forma
With shapes
If .Type = 13 Then
.Delete
End If
End With
Next
With ActiveSheet
'Capturamos pantalla
.Range("A1").Select
Application.SendKeys "(%{1068})"
DoEvents
' Pegamos pantalla
.Paste
End sub

En este ejemplo, las primeras líneas de código sirven para borrar aquellas capturas que hayamos hecho anteriormente (si no lo necesitáis, lo comentáis o lo borráis). Con el resto de código realizamos la captura de pantalla y la pegamos en la misma hoja.

Es posible que necesitéis editar la forma o imagen capturada, esto lo podéis hacer añadiendo al código estas líneas:

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 21
Selection.ShapeRange.IncrementTop 220
Selection.ShapeRange.ScaleWidth 0.98, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.72, msoFalse, msoScaleFromTopLeft

Y las que necesitéis para escalar la imagen, aquí os dejo documentación por si lo necesitáis: Objeto Shape Métodos

Este método de trabajo es especialmente útil si se necesita realizar una captura de pantalla de un proceso que estamos cargando en nuestra hoja (videos, imágenes, etc) y necesitamos en un momento dado, realizar una captura.

Existen otras técnicas, por ejemplo serían:

  • .AddPicture
  • .Pictures.Insert

Sin embargo, éstas se refieren a shapes o imágenes previamente embebidas en nuestra hoja. Con el método anterior capturamos todo lo que aparece en la hoja y lo pegamos de nuevo.

Y eso es todo, espero que os haya resultado de interés.

Saludos.

¿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

ACTUALIZAR UN MÓDULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO

Hola a todos:

El post surge fruto de una consulta, se trataría de actualizar en varios archivos el mismo módulo (estándar o de hoja) pero desde otro archivo, evitando así que una aplicación distribuida entre varios usuarios, cuando es necesaria una actualización de código, se tengan que abrir manualmente cada uno de los archivos.

Veamos un ejemplo, imaginad que tenéis en una carpeta los siguientes archivos:

ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO

En cada uno de estos archivos en el módulo de hoja “Hoja1”  tenemos un determinado código, pero como hemos encontrado algunos errores, tenemos que actualizar este código en cada uno de ellos. Dado que no queremos hacerlo manualmente, lo vamos a programar.

En nuestro archivo, que contiene los siguientes módulos:

ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO_1

En el módulo CODIGO_A_COPIAR vamos a escribir el código que necesitamos exportar a los libros que tenemos en la carpeta. En este caso es un sencillo “Hola Mundo” en un msgbox.

En el módulo ACTUALIZAR tenemos el código que va a permitir realizar todo esto.

Veamos cómo funciona y luego os dejo la rutina comentada.

En primer lugar seleccionamos los archivos:

ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO_2

Ahora vamos a indicar el nombre del módulo:

ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO_3

En este punto es importante tener en cuente que debemos escribir correctamente el nombre del módulo, Por ejemplo es Hoja1 y no “HOJA1” o “hoja1”, el uso de las mayúsculas o minúsculas es importante. El nombre ha de ser el mismo que el que aparezca en el módulo de los archivos que vamos a actualizar.

Una vez que aceptamos, vamos a pasar nuestro mensaje “Hola Mundo” al módulo de hoja “Hoja1” de los cuatro archivos seleccionados.

El código a utilizar sería el siguiente:

Option Explicit
Sub ACTUALIZAR_MODULO()
'Declaramos variables
Dim nArchivos, CodigoCopiar, CodigoPegar
Dim Hojadestino As String, NombreLibro As String
Dim FSO As Variant, i As Long, lineas As Long
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Seleccionamos uno o varios archivos
nArchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=True)
'si no seleccionamos nada, salimos del proceso
If Not IsArray(nArchivos) Then
Exit Sub
Else
'Mostramos inputbox para que el usuario indique el nombre del modulo:estandar o de hoja. Si está vacío, salimos del proceso, si está mal escrito mostramos error
Hojadestino = InputBox("INDICA EL NOMBRE DEL MÓDULO O LA HOJA DONDE SE ENCUENTRA EL CÓDIGO A REEMPLAZAR:" & Chr(13) & Chr(13) & "(VERIFICA EL USO DE MAYÚSCULAS O MINÚSCULAS)", "ARCHIVO SELECCIONADO")
If Hojadestino = Empty Then Exit Sub
'Recorremos mediante un array los archivos seleccionados
For i = LBound(nArchivos) To UBound(nArchivos)
'Abrimos cada archivo
Workbooks.Open Filename:=(nArchivos(i))
'obtenemos el nombre de cada archivo
Set FSO = CreateObject("Scripting.FileSystemObject")
NombreLibro = FSO.GetFileName(nArchivos(i))
'Borramos el código que queremos actualizar en los archivos seleccionados, el módulo ha de llamarse igual en todos.
With ActiveWorkbook
On Error GoTo etiqueta
.VBProject.VBComponents(Hojadestino).CodeModule.DeleteLines 1, .VBProject.VBComponents(Hojadestino).CodeModule.CountOfLines
End With
'seleccionamos y copiamos el código de nuestro libro y que está en el módulo CODIGO A COPIAR
Set CodigoCopiar = ThisWorkbook.VBProject.VBComponents("CODIGO_A_COPIAR").CodeModule
'Pegamos en cada archivo y módulo seleccionado el código que hemos copiado
Set CodigoPegar = Workbooks(NombreLibro).VBProject.VBComponents(Hojadestino).CodeModule
lineas = CodigoCopiar.CountOfLines
CodigoPegar.AddFromString CodigoCopiar.Lines(1, lineas)
'cerramos cada libro que hemos seleccionado y abierto
Workbooks(NombreLibro).Close savechanges:=True
Next i
End If
Exit Sub
'Si hay un error mostramos mensaje.
etiqueta:
MsgBox ("VERIFICA QUE HAS ESCRITO CORRECTAMENTE EL NOMBRE DEL MÓDULO DE LA HOJA, LAS MAYÚSCULAS O MINÚSCULAS SE DEBEN TENER EN CUENTA" _
& Chr(13) & Chr(13) & "POR EJEMPLO: HOJA1 EN LUGAR DE Hoja1, DONDE LO CORRECTO EN Hoja1"), vbCritical
End Sub

Y eso es todo. Sin embargo, me gustaría comentar varias cosas:

La primera: para que el código funcione correctamente, debéis activar la siguiente referencia: Microsoft Visual Basic for Applications Extensibility 5.3

ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO_4

La segunda: Antes de comenzar con el ejercicio, para que la macro funcione es necesario realizar unas modificaciones en el centro de confianza de nuestro programa de Excel. Para hacerlo, debéis entrar en Archivo > Opciones y pulsar en Centro de Confianza:

ELIMINAR UNA MACRO UTILIZANDO OTRA MACRO

A continuación se mostrará esta otra pantalla:

ELIMINAR UNA MACRO UTILIZANDO OTRA MACRO1

Elegimos la opción Configuración de macros y activamos la casilla que pone: Confiar en el acceso al modelo de objetos de proyectos de VBA, y aceptamos.

Es importante que realicemos este paso, si no lo hacemos la macro que os voy a mostrar generará un error y no se ejecutará.

Esto lo debéis hacer tanto para este archivo como para los que vamos a actualizar.

Para finalizar, me gustaría recordar que estamos trabajando con código que borra código, por lo tanto, antes de ejecutarlo en firme, haced varias pruebas con archivos que se pueden borrar o eliminar.

Y eso es todo, os dejo el archivo de prueba, espero que os sea de utilidad.

Descarga el archivo de ejemplo pulsando en: ACTUALIZAR UN MODULO DE VBA EN VARIOS ARCHIVOS DESDE OTRO ARCHIVO

¿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

OBTENER EL TIEMPO DE DURACIÓN DE UNA MACRO

Hola a todos!

En muchas ocasiones, cuando programamos rutinas en VBA, solemos preguntarnos acerca de la duración de nuestros procesos, si con un método de programación la ejecución es más rápida que con otro. Aunque son muchos los factores que influyen en la rapidez y eficiencia de nuestro código (tipo de datos, procesador, memoria, etc …), podemos obtener el tiempo de duración de un proceso entre que se inicia y finaliza.

Para documentar este método utilizaré un ejemplo sencillo, mediante una instrucción For-Next con matrices veremos el tiempo que tarda en ejecutarse el proceso. Imaginad estos datos:

obtener el tiempo de duraciÓn de una macro

Nuestro objetivo es pasar una rutina que agrupe las edades en varios tramos. Para ello, utilizaremos el siguiente código:

Option Explicit
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub TIEMPO_EJECUCION_MACRO()
'Declaramos variables
Dim miarray As Variant, i As Long, n As Long
Dim fin As Long
'Pasamos el resultado de la función GetTickCount a una variable
'Capturamos momento inicial
n = GetTickCount
With Sheets("DATOS")
fin = Application.CountA(Range("A:A"))
'Pasamos rango a matriz
miarray = Range("E2:E" & fin).Value
'Iniciamos el for
For i = UBound(miarray, 1) To LBound(miarray, 1) Step -1
Select Case miarray(i, 1)
'Select case para agrupar edades
Case 1 To 34
Range("F" & i + 1) = "Menor o igual a 34"
Case 35 To 54
Range("F" & i + 1) = "Entre 35 y 54"
Case 55 To 94
Range("F" & i + 1) = "Entre 55 y 94"
Case Else
Range("F" & i + 1) = "Mayor de 95"
End Select
Next
End With
'Mostramos el resultado expresado en milisegundos a segundos (multiplicando el resultado por 0.001)
'Diferencia entre el inicio y final de la macro GetTickCount - n
MsgBox ("LA MACRO HA DURADO: " & (GetTickCount - n) * 0.001 & " SEGUNDOS")
End Sub

Cómo podéis observar la estructura del for es la habitual aunque he introducido el uso de matrices en la estructura. Pues bien, para obtener el tiempo vamos a utilizar una función (se puede hacer de varias formas, pero esta es la que considero más eficaz y fiable). Lo haremos llamando a una función del sistema GetTickCount en el módulo de sistema  kernel32.dll.

Una vez declarada, y antes de que se inicie nuestra macro, utilizaremos una variable para obtener el momento inicial, esto es “n” en nuestro código (como podéis observar está justo después de la declaración de variables).

Para finalizar, y a modo de msgbox, calculamos el resultado en milisegundos, es decir: GetTickCount - n  (para pasarlo a segundos debemos multiplicar por 0.001).

Es importante incluir ambas líneas de código al inicio y al final del código, para que así muestre correctamente

El resultado, después de ejecutar la macro en mi equipo es el siguiente:

obtener el tiempo de duraciÓn de una macro_2

La ejecución del proceso ha durado: 1,281 segundos. Este resultado también lo podéis expresar en otras unidades de tiempo, solo tenéis que aplicar las conversiones al resultado obtenido inicialmente.

Y esto es todo!. Como siempre os dejo el archivo de ejemplo para que lo probéis en vuestros equipos y proyectos.

Descarga el archivo de ejemplo pulsando en: OBTENER EL TIEMPO DE DURACIÓN DE UNA MACRO

¿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

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS

Hola a todos!:

En esta web hay varios post dedicados a ADO y sus ventajas a la hora de obtener información a través de consultas. En el ejercicio de hoy os propongo lo siguiente:

Pulsando un botón de comando en nuestra hoja procederemos a seleccionar un archivo, previamente indicaremos ciertos criterios en cada consulta y lanzaremos nuestro proceso. A continuación obtendremos la información y la importaremos a nuestra hoja.

Veamos el proceso con vídeo:

Efectivamente en una carpeta tenemos el siguiente archivo:

obtener datos de otro archivo con ado e importar varias consultas en tablas

En este archivo tenemos la siguiente información:

obtener datos de otro archivo con ado e importar varias consultas en tablas_1

Y queremos importarnos tres consultas de esta base de datos:

1: Empleados con ID > que 9 y queremos Nombre Completo e ID.
2: Empleados que solo sean Mujeres y traemos ID, Nombre Completo y Estudios.
3: Empleados cuyos estudios son Licenciados y nos traemos ID, Nombre Completo y Edad.

Estas consultas se realizarán en SQL desde nuestro código. Lo primero que debemos hacer es seleccionar el archivo BASE_DATOS para obtener la información.

Eso lo realizaremos con el siguiente código:

narchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=False)
If narchivos = False Then Exit Sub

Seleccionamos archivo:

obtener datos de otro archivo con ado e importar varias consultas en tablas_2

Una vez que lo tenemos seleccionado, ya podemos pasar las consultas, serían estas:

obSQL = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO] FROM [Hoja1$] WHERE [Hoja1$].[ID]> 9"
obSQL1 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[ESTUDIOS] FROM [Hoja1$] WHERE [Hoja1$].[SEXO]= 'MUJER'"
obSQL2 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[EDAD] FROM [Hoja1$] WHERE [Hoja1$].[ESTUDIOS]= 'LICENCIADOS'"

Ahora debemos utilizar el resto de la macro

'Iniciamos un loop que recorra todas las consultas (las incluimos en un array)
For Each consulta In Array(obSQL, obSQL1, obSQL2)
'Iniciamos la conexión con la base de datos
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Connectionstring = "DATA SOURCE=" & narchivos
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Grabamos los datos
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
With Sheets("Hoja1")
Do Until Dataread.EOF
Dataread.MoveFirst
'Pasamos datos a la hoja
.Cells(2, d).CopyFromRecordset Dataread
'Incluimos encabezados
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
Titulos = CDate(Dataread.Fields(i).Name)
Else
Titulos = Dataread.Fields(i).Name
End If
.Cells(1, d + i) = Titulos
Next i
Loop
'Convertimos cada consulta en una tabla
fin = .Cells(Rows.Count, d).End(xlUp).Row
Range(.Cells(1, d), .Cells(fin, d + i - 1)).Select
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, xlYes)
objTable.Name = "Tabla" & x
End With
d = d + i + 1
x = x + 1
Next consulta
'Liberamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing

El resultado de nuestro proceso es el siguiente:

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS_3.jpg

Como podéis observar, hemos ejecutado las tres consultas en el mismo módulo utilizando una instrucción for – each en una matriz que va generando las consultas una a una. Cada vez que recibimos los datos, los importamos y de damos formato tabla.

Esto último es importante, dado que si vinculamos gráficos o tablas dinámicas a esta información, no tenemos que escribir código adicional si aumenta  el rango de datos, siempre haremos referencia a la tabla (que además hemos renombrado).

Trabajando con ADO resulta mucho más sencillo obtener la información, y con nuestro código podemos transformarla hasta obtener lo que necesitamos. Por ello, y aunque ya lo indico siempre que trabajamos con ADO, debéis activar las referencias en vuestro editor de de VBA:

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS_4.jpg

En resumen, la idea es no sobrecargar nuestra hoja de Excel de datos que no necesitamos, simplemente, seleccionamos el archivo fuente e importamos la información de interés previamente seleccionada con consultas.

Para finalizar, os dejo la macro completa:

Option Explicit
Sub CONSULTAS_SQL_ADO()
'Definimos variables
Dim Dataread As ADODB.Recordset, cnn As ADODB.Connection, Titulos As String, objTable As Variant
Dim d As Double, x As Double, i As Double, fin As Double, narchivos As Variant
Dim consulta As Variant, obSQL As String, obSQL1 As String, obSQL2 As String
Dim Table As Variant
'Seleccionamos archivos
Application.ScreenUpdating = False
narchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=False)
If narchivos = False Then Exit Sub
'Eliminamos tablas insertadas en consultas anteriores
For Each Table In ActiveSheet.ListObjects
Table.Delete
Next Table
'Definimos consultas
obSQL = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO] FROM [Hoja1$] WHERE [Hoja1$].[ID]> 9"
obSQL1 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[ESTUDIOS] FROM [Hoja1$] WHERE [Hoja1$].[SEXO]= 'MUJER'"
obSQL2 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[EDAD] FROM [Hoja1$] WHERE [Hoja1$].[ESTUDIOS]= 'LICENCIADOS'"
d = 1
x = 1
'Iniciamos un loop que recorra todas las consultas (las incluimos en un array)
For Each consulta In Array(obSQL, obSQL1, obSQL2)
'Iniciamos la conexión con la base de datos
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Connectionstring = "DATA SOURCE=" & narchivos
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Grabamos los datos
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
With Sheets("Hoja1")
Do Until Dataread.EOF
Dataread.MoveFirst
'Pasamos datos a la hoja
.Cells(2, d).CopyFromRecordset Dataread
'Incluimos encabezados
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
Titulos = CDate(Dataread.Fields(i).Name)
Else
Titulos = Dataread.Fields(i).Name
End If
.Cells(1, d + i) = Titulos
Next i
Loop
'Convertimos cada consulta en una tabla
fin = .Cells(Rows.Count, d).End(xlUp).Row
Range(.Cells(1, d), .Cells(fin, d + i - 1)).Select
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, xlYes)
objTable.Name = "Tabla" & x
End With
d = d + i + 1
x = x + 1
Next consulta
'Liberamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Y con esto tenemos ya creado nuestro proceso de información para la generación de cualquier tipo de informe o reporte.

Espero que os haya resultado de interés.

Descarga el archivo de ejemplo pulsando en: OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS

Y también el archivo de la base de datos para que realicéis la prueba: BASE DATOS

¿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

ORDENAR COLUMNAS DE FORMA ASCENDENTE O DESCENDENTE SI SON PARES O IMPARES

Hola a todos!:

Hace unos días me pedían que modificase una macro publicada hace unos años en esta web para hacer lo siguiente:

Que ordenase los datos contenidos en varios columnas de forma ascendente o descendente en función de si la columna era par o impar. Sobre este punto he de puntualizar que las columnas deben ser contiguas (no deben existir columnas en blanco).

Tenemos los siguiente datos:

ordenar columnas de forma ascendente o descendente si son pares o impares

Lo que pretendemos es que cuando la columna sea par los datos se ordenarán de forma descendente y si son impares, ascendente.

Para ello utilizaremos la siguiente rutina, utilizando un loop for-next para recorrer todas las columnas y obtener así su número.

Sub OrdenarColumnas()
Dim i As Double
'Definimos cuantas columnas debemos ordenar contando las que tienen contenido
fin = Application.CountA(Worksheets("Hoja1").Range("1:1"))
For i = 1 To fin
If Application.WorksheetFunction.IsEven(i) Then
'Verificamos si la columna es par o impar
Range(Cells(1, i), Cells(1, i).End(xlDown)).Select
'Si la columna es par, ordenamos descendente
Selection.AutoFilter
Range(Cells(1, i), Cells(1, i).End(xlDown)).Sort Key1:=Cells(1, i), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Else
Range(Cells(1, i), Cells(1, i).End(xlDown)).Select
'Si la columna es impar, ordenamos ascendente
Selection.AutoFilter
Range(Cells(1, i), Cells(1, i).End(xlDown)).Sort Key1:=Cells(1, i), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Next
End Sub

Una vez aplicada la macro, tenemos el resultado que estamos buscando. Como podéis observar, hemos introducido una condición y utilizado la función IsEven para evaluar si el contenido de la variable “i” es par y si no lo es, será impar.

Pulsa en el botón ordenar y se ejecutará la macro:

ordenar columnas de forma ascendente o descendente si son pares o impares2

Y este fue la respuesta a la consulta realizada : )

Descarga el archivo de ejemplo pulsando en: ORDENAR COLUMNAS DE FORMA ASCENDENTE O DESCENDENTE SI SON PARES O IMPARES

¿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

ENVIAR DATOS DESDE EXCEL A UNA PAGINA WEB (CLASSNAME, NAME)

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

Hace unos días un lector me hacía la siguiente consulta en relación a este post: ENVIAR DATOS DESDE EXCEL A UNA PAGINA WEB – FORMULARIO, necesitaba realizar el mismo ejercicio pero utilizando la propiedad “Name” en lugar del ID. (podéis visitar el post para ver el código de referencia).

Pues bien, en realidad los cambios que hay que hacer en la macro son pocos. En el ejercicio, mediante VBA enviamos al formulario de búsqueda de Excel Signum una palabra y desde el código ejecutamos la búsqueda y mostramos el resultado. Para hacerlo con la propiedad Name, debemos identificar los elementos a incluir en nuestra macro:

ENVIAR DATOS DESDE EXCEL A UNA PAGINA WEB (CLASSNAME, NAME)

Como estamos trabajando con Name, tendremos que detectar los elementos necesarios para nuestro código, en este caso: name=”s” para indicar el contenido en buscador y “submit” para hacer click o ejecutar la búsqueda.

Así quedaría el código:

Sub CARGAR_DATOS_WEB_ByName()
Dim IE As Object
Dim document As Object
Application.ScreenUpdating = False
'Creamos objeto internet explorer
Set IE = CreateObject("InternetExplorer.Application")
'abrimos web
IE.navigate "https://excelsignum.com/"
'esperamos a que se carguen todos los elementos
Do Until IE.ReadyState = 4
DoEvents
Loop
'si necesitamos más tiempo lo podemos configurar aquí
Application.Wait (Now + TimeValue("0:00:01"))
'localizamos el name que hace referencia al cuadro de búsqueda
Set document = IE.document
With document
.getElementsByName("s")(0).Value = "ACCESS"
End With
'también buscamos "name" correspondiente al botón para buscar el valor
With document
.getElementsByName("submit")(0).Click
End With
'hacemos visible la web.
IE.Visible = True
Set IE = Nothing
Application.ScreenUpdating = True
End Sub

Como podéis observar identificamos el name (s) para indicar que el valor de la búsqueda sea “ACCESS”

.getElementsByName("s")(0).Value = "ACCESS"

y ejecutamos la búsqueda haciendo referencia al botón “Buscar”

.getElementsByName("submit")(0).Click

Este es el resultado:

ENVIAR DATOS DESDE EXCEL A UNA PAGINA WEB (CLASSNAME, NAME)1

Efectivamente, desde Internet Explorer se mostrará el resultado de la búsqueda con la palabra “ACCESS” en Excel Signum.

Pero aprovechando que estamos tratando las propiedades ID y Name, podemos también realizar el mismo código con ClassName.

Sub CARGAR_DATOS_WEB_ByClassName()
Dim IE As Object
Dim document As Object
Application.ScreenUpdating = False
'Creamos objeto internet explorer
Set IE = CreateObject("InternetExplorer.Application")
'abrimos web
IE.navigate "https://excelsignum.com/"
'esperamos a que se carguen todos los elementos
Do Until IE.ReadyState = 4
DoEvents
Loop
'si necesitamos más tiempo lo podemos configurar aquí
Application.Wait (Now + TimeValue("0:00:01"))
'localizamos el ClassName que hace referencia al cuadro de búsqueda
Set document = IE.document
With document
.getElementsByClassName("field")(0).Value = "ACCESS"
End With
'también buscamos "ClassName" correspondiente al botón para buscar el valor
With document
.getElementsByClassName("submit")(0).Click
End With
'hacemos visible la web.
IE.Visible = True
Set IE = Nothing
Application.ScreenUpdating = True
End Sub

El resultado es exactamente el mismo que con el código anterior. Y de esta forma ya podéis realizar el mismo ejercicio con el ID, el Name y el ClassName.

Obviamente existen otras formas de realizar estas programación, y es utilizando otros objetos en lugar en I.E. no obstante, eso lo iremos viendo en próximas publicaciones.

Espero que os resulta de interés : )

¿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