ORDENAR EL CONTENIDO NUMÉRICO DE UNA CELDA

Hola a todos:

El post de hoy, como de costumbre, surge como respuesta a una consulta. El lector buscaba una solución para poder ordenar el contenido números de una celda (pero con los números separados por comas).

Sobre este asunto ya he escrito varias entradas relacionadas, en concreto en este post: ORDENAR LAS PALABRAS DE UNA CELDA ALFABÉTICAMENTE.

Aunque en ese ejemplo trabajaba con palabras, una sencilla modificación podría servir para realizar el ejercicio. Por ejemplo, si tenemos este número en una celda: 8,2,9,9,6,5 y queremos este dato: 2,5,6,8,9,9 utilizaremos esta función (UDF):

Function OrdenarNumCom(ByVal micelda As String)
'Declaramos las variables
Dim Matriz As Object, numero As Variant, num As Variant
Dim inum As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Por cada objeto/palabra contenida en la celda seleccionada
For Each numero In Split(micelda, ",")
'Añadimos cada palabra a la matriz con un bucle
Matriz.Add numero
Next numero
'Una vez la matriz creada la ordenamos
Matriz.Sort
'Pasamos los datos ya ordenados a una cadena de texto
For Each num In Matriz
inum = inum & "," & num
Next num
OrdenarNumCom = Trim(Mid(inum, 2, Len(inum)))
'Limpiamos variable de objeto
Set Matriz = Nothing
End Function

Si lo que queremos hacer es ordenar los números pero sin comas, por ejemplo: 715017 y queremos obtener esto: 011577 utilizaremos esta macro:

Function Ordenanum(ByVal micelda As String)
'Declaramos las variables
Dim Matriz As Variant, num As Variant, inum As String
Dim numero As String, j As Long
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Por cada núumero contenido en la celda seleccionada
For j = 1 To Len(micelda) Step 1
numero = Mid(micelda, j, 1)
'Añadimos cada número a la matriz con un bucle
Matriz.Add numero
Next j
'Una vez la matriz creada la ordenamos
Matriz.Sort
'Pasamos los datos ya ordenados
For Each num In Matriz
inum = inum & "" & num
Next num
Ordenanum = inum
'Limpiamos variable de objeto
Set Matriz = Nothing
End Function

Con estas dos funciones podremos realizar perfectamente el trabajo. Y en el caso de la función que ordena los números separados por comas, si el separador es otro, solo tenemos que cambiarlo en el código y funcionará perfectamente.

ORDENAR EL CONTENIDO NUMÉRICO DE UNA CELDA

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

Descarga el archivo de ejemplo pulsando en: ORDENAR EL CONTENIDO NUMÉRICO DE UNA CELDA

¿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 BUSCARV EN VBA

Hola a todos:

En esta web hay dos post dedicados a cómo programar la función Buscarv en VBA.

En el primero de ellos utilizo la notación RC en la fórmula (prácticamente como aparece después de utilizar la grabadora de macros) y aplico la fórmula a un rango determinado de celdas: FUNCIÓN BUSCARV EN VBA

La ventaja de utilizar este método es la rapidez, sin embargo el uso de la notación RC hace que sea complicado el realizar modificaciones de las columnas y celdas que intervienen en el proceso. Además de dejar poco margen para la introducción de condicionales.

En el segundo, utilizo el objeto “WorksheetFunction” para llamar desde VBA a la función Buscarv.  UTILIZAR CUADRO DE DIÁLOGO PARA SELECCIONAR ARCHIVO Y BUSCARV , aquí además utilizo una instrucción for-next para recorrer las celdas en las que necesitamos encontrar y en las que queremos incluir el valor encontrado. Este método es más lento, pero permite introducir otras funciones al proceso de forma muy sencilla, al estar utilizando un bucle y hacer referencias a las celdas.

En el post de hoy os mostraré otra alternativa, muy parecida a la primera, pero que permite que la función sea más fácil de utilizar. Usaré la misma plantilla que para el primer post:

BUSCARV EN VBA_3

Y la macro es la siguiente:

Option Explicit
Sub BUSCARV()
'DECLARAMOS VARIABLES
Dim Fin As Long, Final As Long, i As Long
Dim Titulos As Variant, T_rango As Object
Dim Cl_datos As Long
'Seleccionamos la hoja listado y limpiamos las celdas que tengan contenido
Worksheets("LISTADO").Select
Cl_datos = Application.CountA(Worksheets("LISTADO").Range("a:a"))
Sheets("LISTADO").Range("C2:D" & Cl_datos).Clear
'Determinamos la longitud del rango de los datos con un contarA
Fin = Application.CountA(Worksheets("LISTADO").Range("A:A"))
Final = Application.CountA(Worksheets("DATOS").Range("A:A"))
'Aplicamos la función buscarv para buscar el nombre y si no está que el resultado sea vacío, situamos el resultado en el rango
'B2 en adelante
With Worksheets("LISTADO").Range("B2:B" & Fin)
.Formula = "=IF(ISERROR(VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",2,0)),"""",VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",2,0))"
'.Formula = .Value
End With
'Aplicamos la función buscarv para buscar los estudios y si no están que el resultado sea vacío, situamos el resultado en el rango
'C2 en adelante
With Worksheets("LISTADO").Range("C2:C" & Fin)
.Formula = "=IF(ISERROR(VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",3,0)),"""",VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",3,0))"
.Formula = .Value
End With
'Aplicamos la función buscarv para buscar si sabe o no inglés y si no está que el resultado sea vacío, situamos el resultado en el rango
'D2 en adelante
With Worksheets("LISTADO").Range("D2:D" & Fin)
.Formula = "=IF(ISERROR(VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",4,0)),"""",VLOOKUP(A2,DATOS!$A$2:$D$" & Final & ",4,0))"
.Formula = .Value
End With
'Nombramos el encabezado de cada columna
With Worksheets("LISTADO")
Titulos = Array("Nombre", "Estudios", "Ingles")
Set T_rango = Worksheets("LISTADO").Range("B1:D1")
T_rango.Value = Titulos
'Coloreamos de rojo
T_rango.Interior.Color = vbRed
End With
End Sub

Como podéis observar, utilizamos la propiedad “.formula” del rango establecido y la escribimos sin utilizar la notación RC. Así resulta mucho más sencillo determinar qué rango es el que debemos seleccionar.

Este método al igual que el primero permite una mayor rapidez en comparación con el uso de bucles. Y nos aseguramos en pasar a valores el resultado de la fórmula. Si queremos que se quede con la fórmula, simplemente eliminamos esta igualación en todas las líneas del código:

.Formula = .Value

Y eso es todo, simplemente quería dejar en esta web otras forma de hacer el mismo procedimiento.

Espero que os resulta de interés.

Descarga el archivo de ejemplo pulsando en: PROGRAMAR BUSCARV EN 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

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES

Hola a todos!

El post de hoy va a ser distinto a los que acostumbro a subir a la web, sobre todo porque está programado en WORD.

Hace ya tiempo que escribí un post relacionado con Combinar Correspondencia, en concreto para intentar dar solución a un problema muy común cuando se realiza esta funcionalidad con WORD, es decir, el obtener de manera individual todos los documentos generados.

Si no estáis familiarizados con Combinar Correspondencia, en este enlace podéis leer en profundidad de qué se trata. Si bien, en resumen, combinamos los campos de un archivo de Excel con una plantilla en WORD y generamos tantos documentos como datos tengamos en Excel. Podemos enviar por correo electrónico cada documento a su destinatario o generar los documentos todos a la vez, de uno en uno o por tramos.

Pero entonces, ¿cuál es el problema?, pues que si tenemos que generar 500 cartas (individuales), sería bastante tedioso el tener que generar y guardar cada documento de uno en uno manualmente.

Ante esta necesidad, en un primer avance lo he realizado con Excel directamente, y el proceso funciona correctamente, pero tiene sus limitaciones (fundamentalmente los formatos). Para solucionarlo me he decidido a hacerlo en Word. Me documenté con algunos procesos que se proponen en Internet, pero no me acababan de convencer, eran demasiado manuales y poco intuitivos. Así que he creado un proceso bastante más automatizado para facilitar la experiencia del usuario.

El primer paso que debemos realizar es obtener el archivo de WORD con los documentos ya generados, todos en el mismo archivo. Importante, el proceso está programado para documentos que ocupen un folio (una hoja de Word).

Pues bien, vamos a hacerlo paso a paso:

  • Generamos los documentos con Combinar correspondencia. Vamos a partir del siguiente listado en Excel (100 líneas)

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES

  • Combinamos correspondencia con el siguiente texto:

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES1

Una vez que hemos combinado y generado todos los documentos obtendremos un archivo de 100 hojas (una por empleado de la base de Excel).

A continuación, ese documento lo vamos a guardar, pero lo haremos o bien como .Doc o como .Docm (para macros), pero no .Docx. El motivo es que vamos a incluir una macro en el documento y con extensión .Docx no permite guardar con macros. Para este ejemplo lo denominaré como “DOCUMENTOS GENERADOS”

Hasta este punto ya tenemos el archivo de Word que queremos trocear en 100 archivos. Ahora debemos crear una carpeta o saber en cuál vamos a importar todos estos archivos, en mi ejemplo la crearé y la denominaré: “DESTINO”.

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES3

Y ya tenemos todo lo necesario para abrir DOCUMENTOS GENERADOS, crear un módulo estándar y pegar nuestra macro:

Option Explicit
Sub COMBINAR()
'DECLARAMOS VARIABLES
Dim mArchivo As Variant, fdocument As Document
Dim miExcel As String, target As Variant, obSQL As String
Dim cnn As Object, dataread As Object, filas As Long
Dim i As Long, iname As Variant, midoc As Document
Dim mi_archivo As String, campo As String, miCarpeta As Variant
Dim texto As Variant, target_a As Variant
'Capturamos documento actual
Set fdocument = ThisDocument
'Abrimos ventana de diálogo para seleccionar el archivo Excel
'que hemos combinado
Set mArchivo = Application.FileDialog(msoFileDialogOpen)
If mArchivo.Show = 0 Then Exit Sub
miExcel = mArchivo.SelectedItems(1)
'Abrimos ventana de diálogo para seleccionar la carpeta en la que
'guardaremos todos los archivos independientes
Set miCarpeta = Application.FileDialog(msoFileDialogFolderPicker)
If miCarpeta.Show = 0 Then Exit Sub
miCarpeta = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
'Generamos documento nuevo
Set target = Documents.Add
'Con instrucción SQL seleccionamos el nombre de la hoja
'y el campo con el que queremos identificar cada documento de word
obSQL = "SELECT [BBDD$].[NOMBRE COMPLETO] FROM [BBDD$]"
'Iniciamos conexión ADO para pasar una tabla con los items
'del campo seleccionado
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Connectionstring = "DATA SOURCE=" & miExcel
.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
'Grabamos los datos en el documento Word generado (target)
dataread.MoveFirst
filas = dataread.RecordCount
Selection.InsertAfter dataread.Fields(0)
Do Until dataread.EOF
dataread.MoveNext
If dataread.EOF = "Verdadero" Then Exit Do
campo = Replace(dataread.Fields(0), "-", " ")
Selection.InsertAfter Chr(11) & campo
Loop
'Formateamos los datos grabados como una tabla
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
numcolumns:=1, Numrows:=filas, AutoFitBehavior:=wdAutoFitFixed
Set midoc = ActiveDocument
'Recorremos la tabla
For i = 1 To midoc.Tables(1).Rows.Count
Set iname = midoc.Tables(1).Cell(i, 1).Range
'Eliminamos de cada dato el retorno de carro, Chr(13).
'Eliminamos el último caracter de la cadena de texto
mi_archivo = Mid(Replace(miCarpeta & iname.Text, Chr(13), ""), 1, Len(Replace(miCarpeta & iname.Text, Chr(13), "")) - 1)
'Recorremos todas las hojas del documento word actual
'Creamos un nuevo documento y pasamos el contenido de cada combinación.
Set texto = fdocument.Sections(i).Range
texto.End = texto.End - 1
Set target_a = Documents.Add
target_a.Range.FormattedText = texto
'Nombramos cada documento con el nombre
'de la hoja que contiene los datos extraidos de Excel
target_a.SaveAs FileName:=mi_archivo
'Cerramos cada documento
target_a.Close
Next i
'cerramos el documento con los datos de Excel
ActiveDocument.Close SaveChanges:=False
End Sub

Después de pegar la macro, debemos activar las referencias para trabajar con ADO: Microsoft ActiveX Data Object 2.8 Library (en caso de no tener esta librería podéis probar con otra de la lista).

Este paso debéis hacerlo, de lo contrario se mostrará un error y no podréis continuar.

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES4

Otro paso que debemos realizar manualmente es determinar el campo del archivo Excel a incluir en el documento de Word.

Debemos especificarlo en la siguiente línea de código:

obSQL = "SELECT [BBDD$].[NOMBRE COMPLETO] FROM [BBDD$]"

Donde la hoja de nuestro archivo Excel se denomina BBDD, debemos especificarlo en la sentencia SQL y siempre con el dólar al final. El campo que vamos a incluir será NOMBRE COMPLETO y también lo especificamos en el SQL. Este paso es importante, si el nombre de la hoja o del campo no es correcto, se mostrará un error y no podremos continuar. Si se muestra el error, debéis reiniciar la macro para volver a ejecutarla y eliminar el documento en blanco que se creó antes de llegar al error.

Pero sigamos, suponiendo que ya tenemos la macro totalmente preparada, cuando la ejecutemos se mostrará un cuadro de diálogo para seleccionar el archivo Excel:

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES6

A continuación se volverá a abrir otro cuadro de diálogo para seleccionar la carpeta en la que dejaremos todos los 100 documentos creados:

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES7

Después dejaremos que se vayan generando los documentos hasta que finalice la macro, el resultado será este:

COMBINAR CORRESPONDENCIA Y GUARDAR DOCUMENTOS INDEPENDIENTES5

Como podéis observar hemos generado 100 documentos y los hemos identificado con su nombre (podría ser con otro campo cualquiera que sea un identificados único).

Y eso es todo!. Espero que el post sea lo bastante claro y no os queden dudas, pero en cualquier caso, os dejaré los dos archivos para que realicéis pruebas.

Descarga el archivo de ejemplo pulsando en: DOCUMENTOS GENERADOS

Descarga el archivo de ejemplo pulsando en: BASE EXCEL PARA COMBINAR

¿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

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

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