PROGRAMAR LA FUNCIÓN SIFECHA EN VBA

Hola a todos:

El post de hoy va a tratar de cómo podemos programar la función SIFECHA en vba. Como sabéis en VBA existe otra función similar (Dateiff) pero a diferencia de la primera, en esta no podemos obtener los meses o los días en relación al año en curso: por ejemplo: no es lo mismo decir que desde que nací han pasado 39 años, 9 meses y 27 días que decir que desde que he nacido han pasado 39 años o ( en meses) 477 meses o (en días) 14.548 días. Lo que nos interesa es obtener en VBA los 39 años, 9 meses y 27 días.

En VBA no existe como tal la función sifecha, para poder programarla es necesario evaluar la fórmula, es decir crearla en un string y aplicarla luego en la hoja para obtener el resultado. Antes de seguir os dejo un post anterior donde comento las diferencias entre dateiff y dateif y otro método muy similar de programación: FUNCIÓN DIASEM, FORMAT, TEXT, DATEDIFF Y DATEDIF PARA CALCULO DE FECHAS EN VBA

Bien, vamos a usar una seria de fechas de nacimiento para ilustrar nuestro ejercicio:

PROGRAMAR LA FUNCIÓN SIFECHA EN VBA

El código que vamos a utilizar es el siguiente:

Option Explicit
Sub SI_FECHA()
'Declaramos variables
Dim i As Long, fin As Long
Dim f_nac As Date, año As String, mes As String
Dim dia As String, titulos As Variant, t_rango As Range
'Recorremos fechas y guardamos valor en variable f_nac
With Sheets("Hoja1")
fin = Application.CountA(.Range("A:A"))
For i = 2 To fin
f_nac = CDate(.Cells(i, 1))
'Generamos tres cadenas de texto con la fórmula "sifecha" aplicada para año, mes y día
año = "=DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""Y"")"
mes = "=DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""YM"")"
dia = "=DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""MD"")"
'Pasamos la información a las columnas 2, 3 y 4 respectivamente
.Cells(i, 2) = año
.Cells(i, 2).Value = .Cells(i, 2).Value
.Cells(i, 3) = mes
.Cells(i, 3).Value = .Cells(i, 3).Value
.Cells(i, 4) = dia
.Cells(i, 4).Value = .Cells(i, 4).Value
'Concatenamos la fecha completa con una única fórmula. (Se podría realizar también concatenando las columnas de año, mes y día).
.Cells(i, 5) = "=DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""Y"") &"" Años, ""& DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""YM"") &"" Meses, ""& DATEDIF(" & Chr(34) & f_nac & Chr(34) & "," & Chr(34) & Date & Chr(34) & " , ""MD"") &"" Días"""
.Cells(i, 5).Value = .Cells(i, 5).Value
Next i
'Mostramos encabezados
titulos = Array("AÑOS", "MESES", "DIAS", "FECHA COMPLETA")
Set t_rango = Worksheets("Hoja1").Range("B1:E1")
t_rango.Value = titulos
t_rango.Interior.Color = vbRed
End With
End Sub

Utilizando una instrucción For pasamos cada fecha de nacimiento a la variable f_nac para utilizarla en la función sifecha. Como podéis observar, escribimos la función en una cadena de texto que luego pasamos a la celda indicada en la Hoja1. Cuando la fórmula pasa a la celda obtenemos el mismo resultado que si la aplicásemos directamente como una función en la hoja.

Os he dejado por separado los años, meses y días y luego la fecha completa. Aunque lo que he realizado ha sido un concatenado de fórmulas con sifecha, esto también lo podéis hacer concatenando las celdas de las columnas 2,3 y 4 (por si os resulta más sencillo).

Y así es como podemos programar la función SIFECHA en VBA con variables incluidas en su sintaxis.

PROGRAMAR LA FUNCIÓN SIFECHA EN VBA1

Esta función también la he programado para ser usada en un formulario, os dejo el enlace al post: CALCULAR LA EDAD CON DATEDIF EN UN FORMULARIO DE EXCEL

Y eso es todo: como siempre os dejo el archivo de prueba:

Descarga el archivo de ejemplo pulsando en: PROGRAMAR LA FUNCIÓN SIFECHA 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

Anuncios

SINCRONIZAR LA INFORMACIÓN DE VARIOS LISTBOX

Hola a todos!

Qué tal os va?, espero que muy bien!. El post de hoy tratará sobre los listbox y la posibilidad de sincronizar la información entre varios.

Como es habitual, el post surge fruto de una duda, en la que el lector planteaba la siguiente problemática: Tenía varios listbox en los que se mostraban varios campos de un tabla de Excel y lo que necesitaba es que si en el primero seleccionada un determinado ítem, en el segundo se debía mostrar la información relacionada con ese ítem, y así hasta varios.

Como sabéis, cuando cargamos información en varios listbox, aunque provengan de la misma tabla, la selección y el uso del scroll es totalmente independiente el uno del otro. Para hacer lo que el lector solicita, debemos sincronizarlos. Ahora os mostraré el ejemplo.

Vamos a cargar una base de datos en 3 listbox:

SINCRONIZAR LA INFORMACION DE VARIOS LISTBOX

En este ejemplo voy a utilizar ADO para cargar los listbox (no es el tema del post) y ya lo vimos en otras entradas, por ejemplo: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL por eso, no voy a publicar aquí el código, os lo dejo en el archivo de prueba.

Pues bien, la información cargada quedaría así:

SINCRONIZAR LA INFORMACION DE VARIOS LISTBOX_1

Como podéis observar he dejado un textbox para realizar búsquedas dado que he reutilizado parte del código de la entrada que os he mencionado al principio.

Y ahora, para sincronizar los listbox, debemos utilizar el evento click en cada uno de ellos y pegar este código en el formulario:

Private Sub ListBox1_Click()
ListBox2.ListIndex = ListBox1.ListIndex
ListBox2.TopIndex = ListBox1.TopIndex
ListBox3.ListIndex = ListBox1.ListIndex
ListBox3.TopIndex = ListBox1.TopIndex
End Sub

Private Sub ListBox2_Click()
ListBox1.ListIndex = ListBox2.ListIndex
ListBox1.TopIndex = ListBox2.TopIndex
ListBox3.ListIndex = ListBox2.ListIndex
ListBox3.TopIndex = ListBox2.TopIndex
End Sub

Private Sub ListBox3_Click()
ListBox1.ListIndex = ListBox3.ListIndex
ListBox1.TopIndex = ListBox3.TopIndex
ListBox2.ListIndex = ListBox3.ListIndex
ListBox2.TopIndex = ListBox3.TopIndex
End Sub

Lo que estamos haciendo es igualar la propiedad .ListIndex para identificar el elemento que tiene el foco y el .TopIndex para detectar el elemento en la parte superior del listbox.

El resultado será que siempre marcaremos la línea de información del ítem seleccionado en todos los listbox:

SINCRONIZAR LA INFORMACION DE VARIOS LISTBOX_2

y eso es todo. Ya está solucionada la consulta : )

Descarga el archivo de ejemplo pulsando en: SINCRONIZAR LA INFORMACIÓN DE VARIOS LISTBOX

¿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

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