funcion-para-traducir-texto-en-nuestra-hoja-excel

FUNCIÓN PARA TRADUCIR TEXTO EN NUESTRA HOJA EXCEL

Hola a todos:

Hace unos días estaba trabajando con unos textos en inglés, nada relacionado con Excel, sino con unos apuntes de teoría política que me interesaban bastante. Lo cierto es que tuve que recurrir varias veces al traductor de Google, dado que no recordaba el significado concreto de algunas expresiones.

Esto me dio una idea, ¿por qué no confeccionar una función que se sea capaz traducir el valor que contenga una celda en Excel, algo así como “TraducirV”?, pues claro que sí, y es bastante sencillo.

Para hacer nuestro trabajo, vamos a utilizar la siguiente función que obtiene del traductor de google la traducción de la palabra que queremos traducir:

Public Function TRADUCIRV(ByVal palabra As String, input_word As String, output_word As String)
'Declaramos variables
Dim RESPUESTA As String
Dim ie As Object
'Creamos aplicación (internet explorer)
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate ("http://translate.google.com/?") & "hl=es#" & input_word & "/" & output_word & "/" & palabra
'Aunque utilizamos ReadyState, vamos a ralentizar la macro 3 segundos
Application.Wait (Now + TimeValue("0:00:03"))
Do Until ie.ReadyState = 4
DoEvents
Loop
'Obtenemos la traducción, extrayendo el texto por ID
RESPUESTA = ie.Document.getElementById("result_box").innerText
TRADUCIRV = RESPUESTA
ie.Quit
End Function

Con esto ya tenemos en nuestro libro Excel una nueva función, denominada “TRADUCIRV”🙂

la sintaxis de la función es la siguiente:

=traducirv(texto a traducir;idioma actual;idioma al que queremos traducir)

Por ejemplo, si queremos traducir del español (“es”) al inglés (“en”), esta sería la fórmula:

=traducirv(A2;"es";"en")

Y podemos traducir cualquier texto a cualquier de los idiomas que aparecen en el tractor de Google, por ejemplo, si traducimos “nadie sabe de lo que es capaz hasta que lo intenta” al georgiano (“ka”), la fórmula sería =traducirv(A2;”es”;”ka”) y el resultado sería este: არავინ იცის, რა მას შეუძლია, სანამ ის ცდილობს

funcion-para-traducir-texto-en-nuestra-hoja-excel

En al archivo os dejo los nombres y las abreviaturas de los idiomas del traductor de google, por si queréis probar algunos idiomas.

En la función, cuando hagáis referencia a los idiomas, debéis colocar las abreviaturas en minúsculas y entre comillas dobles, de lo contrario obtendréis un error. (En la función también podéis hacer referencia a la celda que contiene la abreviatura y no tener que escribirla, en ese caso irá sin comillas.)

Otro asunto importante es que algunos idiomas, dependiendo de la versión de Excel  puede que no se muestren correctamente, por ejemplo, el Birmano, en excel 2010 no se muestra, sin embargo en Excel 2016 sí. De hecho, es en 2016 donde se muestran todos los idiomas correctamente.

Pues esto ha sido todo, una pequeña función para poder traducir desde nuestra hoja Éxcel un texto a multitud de idiomas.

Descarga el archivo de ejemplo pulsando en: FUNCIÓN PARA TRADUCIR TEXTO EN NUESTRA HOJA EXCEL

 

api-geolocalizacion-vba-con-formato-xml

API GEOLOCALIZACIÓN EN VBA CON FORMATO XML

La semana pasada escribí un post sobre la geolocalización y cómo podemos adaptar el API de Maps a Excel mediante VBA: API GEOLOCALIZACIÓN EN VBA. En ese ejemplo trabajábamos con un formato de datos de salida de Maps denominado jSON y en el que utilizábamos varias funciones para extraer información de una cadena de datos alfanumérica.

En en mismo post comentaba que en breve realizaría el mismo ejemplo pero utilizando datos de salida XML. Esto implica modificar programación en la función principal y utilizar una única función secundaría.

Antes de mostrar estas funciones os dejo el ejemplo de la respuesta a una consulta a Maps con formato XML:

api-geolocalizacion-vba-con-formato-xml

Como podéis observar existen diferencias significativas en ambos formatos (jSON y XML). Sin embargo, a la hora de programar este tipo de formato nos ayudará a reducir la función, además la he implementado de tal forma que no es necesario el tener que acudir a las referencias a activar la casilla de Microsoft XML, V6.0 dado que la función crea los objetos necesarios para realizar la consulta.

Al igual que en el post anterior conservaremos la función que modifica los caracteres especiales. Haremos referencia a la segunda hoja, que es el lugar en el que los he colocado:

Private Function Caracter_a(ByVal Destino) As String
Dim i As Integer, fin As Integer
With Sheets(2)
fin = Application.CountA(.Range("A:A"))
'Aplicamos un bucle para sustituir caracteres especiales
For i = 1 To fin
Destino = Replace(Destino, .Cells(i, 1), .Cells(i, 2))
Next
Caracter_a = Destino
End With
End Function

Ahora ya podemos insertar la función que nos traerá las coordenadas de latitud y longitud a nuestra hoja, función GeocodingXML

Function GeocodingXML(Destino As String) As String
'Declaramos las variables
Dim Consulta As String
Dim Peticion As Object
Dim Respuesta As Object
Dim iNodos As Object
'Indicamos parámetros de la consulta
Consulta = "http://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & Caracter_a(Destino) & "&sensor=false"
'Creamos los objetos (evitando así tener que marcar referencias en la biblioteca)
Set Peticion = CreateObject("Microsoft.XMLHTTP")
Set Respuesta = CreateObject("Msxml2.DOMDocument.6.0")
Set iNodos = Respuesta.createNode(1, "xml", "")
'Realizamos la consulta
Peticion.Open "GET", Consulta, False
Peticion.send
Respuesta.LoadXML (Peticion.responseText)
'Extraemos las coordenadas
Set iNodos = Respuesta.getElementsByTagName("location")
For i = 0 To iNodos.Length - 1
'Reemplazamos el espacio en blanco entre latitud y longitud por una coma
GeocodingXML = Replace(iNodos(i).Text, " ", ",")
Next
End Function

Si comparáis este código y el del post anterior, veréis que es mucho más corto y que el método para extraer los datos los realizamos mediante el método “getElementsByTadName” lo que nos permite extraer los datos alojados en los nodos del nombre al que hacemos referencia (“location”). Es decir latitud y longitud.

Personalmente suelo utilizamos esta función (y método) cuando trabajo realizando consultas web, es mucho más sencillo.

El resultado es el mismo que en el post anterior:

api-geolocalizacion-vba-con-formato-xml1

Pues eso ha sido todo. Ya tenemos dos UDF listas para extraer las coordenadas de cuaquier lugar que necesitemos.

Saludos🙂

Descarga el archivo de ejemplo pulsando en: API GEOLOCALIZACIÓN EN VBA CON FORMATO XML

 

api-geolocalizacion-en-vba4

API GEOLOCALIZACIÓN EN VBA

Uno de los post que tiene más visitas en Excel Signum es API MATRIZ DE DISTANCIAS, donde obtenemos el tiempo y la distancia a partir de un origen y un destino, realizando la petición de información a Google Maps.

Hace unos días, un lector me solicitó ayuda para conseguir los datos de geolocalización  de una serie de direcciones (latitud y longitud) y me pareció interesante para realizar una nueva entrada basada en esta consulta.

Antes de nada, comentar que existen varias alternativas para realizar este trabajo, todas ellas pasando por el API de Google Maps de geolocalización. Para este ejemplo usaré el API con formato de datos de salida jSON (en breve os mostraré otra versión con formato XML). Si queréis leer acerca del API y sus especificaciones, podáis hacerlo aquí: Google Maps Geocoding API

Utilizaremos un caso práctico para ilustrar el ejercicio, imaginad que hemos previsto realizar un pequeño viaje y queremos visitar: La Plaza Mayor (Chinchón), El Palacio Real (Aranjuez) y el Alcázar de Toledo. El punto de partida en el que hemos quedado es la Plaza de Santa Ana (Madrid), y queremos obtener las coordenadas de dichos lugares a partir de sus direcciones. Lo indicamos de la siguiente forma en nuestra hoja Excel:

api-geolocalizacion-en-vba

La idea es crear una función que capture el elemento de la columna B (Dirección) y nos devuelva en la columna C las coordenadas de latitud y longitud. Para ello vamos a utilizar 3 funciones. Una será la principal y las otras dos serán secundas pero muy importantes.

Antes de montar la función principal vamos a ver las otras, la primera es Carácter_e:

Private Function Caracter_e(ByVal Destino) As String
Dim i As Integer, fin As Integer
With Sheets(2)
fin = Application.CountA(.Range("A:A"))
'Aplicamos un bucle para sustituir caracteres especiales
For i = 1 To fin
Destino = Replace(Destino, .Cells(i, 1), .Cells(i, 2))
Next
Caracter_e = Destino
End With
End Function

Con esta función, a la hora de pasar los parámetros a Maps, convertimos aquellos caracteres especiales  (ejem: tildes, eñes, etc) que normalmente crear errores a caracteres válidos. Los parámetros los he puesto en la segunda hoja, (en caso de que necesitéis añadir alguno más solo tenéis que indicarlo como el resto):

api-geolocalizacion-en-vba1

La otra función que vamos a utilizar es aquella que extraerá de la cadena de datos solo los números, las comas, los puntos y los guiones.

Public Function Numeros(LatLong As String)
Dim i As Double, j As Double
Dim num As Variant
'extraemos números, comas, guiones y puntos de la cadena alfanumérica
With Sheets(1)
For i = Len(LatLong) To 1 Step -1
If IsNumeric(Mid(LatLong, i, 1)) Or Mid(LatLong, i, 1) = "," Or Mid(LatLong, i, 1) = "-" Or Mid(LatLong, i, 1) = "." Then
j = j + 1
num = Mid(LatLong, i, 1) & num
End If
If j = 1 Then num = (Mid(num, 1, 1))
Next i
Numeros = num
End With
End Function

Esta función (Numeros) es necesaria dado que cuando extraemos los datos mediante la función principal, en formato jSON, tendremos que extraer la información de Latitud y Longitud. Este es el formato de salida:

api-geolocalizacion-en-vba2

Ahora que ya hemos visto estas dos funciones os dejo la función principal Geocoding()

Function Geocoding(Destino As String) As String
Dim Consulta As String
Dim ObjetoXML As Object
Dim Peticion As String
Dim Marcador As Long
Dim sCadena As String
Dim LatLong As String
'Pasamos parámetros de la consulta y aplicamos función caracter_e
'por su tenemos caracteres especiales
Consulta = "http://maps.googleapis.com/maps/api/geocode/json?" _
& "&address=" & Caracter_e(Destino) & "&sensor=false"
'Enviamos la consulta y recibimos respuesta
Set ObjetoXML = CreateObject("Microsoft.XMLHTTP")
ObjetoXML.Open "GET", Consulta, False
ObjetoXML.send
Peticion = ObjetoXML.responseText
'extraemos los datos de latitud y longitud que necesitamos
'de la cadena que hemos obtenido
Marcador = InStr(1, Peticion, "location")
sCadena = Application.WorksheetFunction.Trim(Mid(Peticion, Marcador, 120))
'Para extraer las coordenadas usamos la función Números para que extraiga numeros, puntos, comas y guiones
LatLong = Numeros(Mid(sCadena, InStr(1, sCadena, "{"), (InStr(1, sCadena, "}") - InStr(1, sCadena, "{") + 1)))
'Obtenemos el resultado
Geocoding = LatLong
'Liberamos variable ObjetoXML
Set ObjetoXML = Nothing
End Function

Una vez que tenemos la cadena de texto, solo tendremos que realizar algunos ajustes para extraer los datos que necesitamos y que realizamos con diferentes funciones y recogeremos en las variables Marcador, sCadena y  LatLong

El resultado es el siguiente:

api-geolocalizacion-en-vba3

El botón que he colocado en la página es para visualizar mediante una sencilla macro la ruta que queremos realizar tomando como datos los códigos, está en el módulo2 de la hoja:

Sub Mapa()
Dim URL As String
With Sheets(1)
'Componemos la url para mostrar el mapa con la ruta.
URL = "https://www.google.com/maps/dir/" & .Range("C2") & "/" & .Range("C3") & "/" & .Range("C4") & "/" & .Range("C5")
ActiveWorkbook.FollowHyperlink URL, NewWindow:=False
End With
End Sub

Y la información que pasamos a maps nos muestra el siguiente mapa:

api-geolocalizacion-en-vba4

Como habéis podido comprobar, la información es correcta. He querido utilizar esta forma de extraer información de un archivo jSON para utilizar algunas de las funciones que hemos visto en el blog y demostrar así su utilidad (Números o Carácter_e).

Por último me gustaría recordaros que esta versión del API tiene una limitación diaria a 2.500 consultas. Lo podéis ver aquí: Límites de uso

En los próximos días os mostraré otra función pero trabajando con datos XML y utilizando otras variables y funciones para extraer la misma información.

Pues esto ha sido todo, como siempre os dejo el archivo:

Descarga el archivo de ejemplo pulsando en: API GEOLOCALIZACIÓN EN VBA

 

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba3

CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL CON VBA

Hola todos, ¿qué tal vais? ¡Seguro que bien!🙂

Hoy me gustaría tratar un tema bastante recurrente cuando en nuestros procesos diarios trabajamos con cantidades bastante elevadas de archivos. Me refiero, por ejemplo, a que seamos los receptores de reportes diarios o mensuales de informaciones tipo, ventas, clientes, ingresos, etc.

Cuando sucede esto, solemos acabar con varias carpetas donde vamos almacenando la información por mes o por día y a la que habitualmente acudimos y confeccionamos nuestros reportes COPIANDO Y PEGANDO A MANO.

Esta situación la puedes tener un día, pero no debe darse habitualmente, por ello, he estado trabajando en un macro para resolver este problema.

Vamos a realizar un caso práctico, y vamos a utilizar nuestra base de datos de ejemplo, la del personal ficticio de unos grandes almacenes. En total son 180 empleados:

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba

Para realizar un ejemplo, vamos a crear tres libros con tres hojas cada uno y en cada pestaña pegaremos 20 empleados y luego guardamos los archivos en una carpeta (CONSOLIDADO):

consolidar-informacion-de-varios-archivos-en-una-hoja-excel-con-vba1

La idea es que con mediante un proceso podamos juntar de nuevo todas las hojas en un único archivo.

Para configurar nuestra hoja vamos a crear dos pestañas, una que vamos a denominar “CONSOLIDAR”,  y otra, en la segunda hoja que vamos a denominar “AGRUPADO”.

En la primera hoja colocaremos un botón de acción para ejecutar la macro y la segunda nos servirá para agrupar toda la información.

Una vez realizado esto, ya podemos pegar la siguiente macro:

Sub CONSOLIDAR()
Dim path As String, MiLibro As String
Dim FilaInicio As Integer
Dim i As Integer
Dim iArchivo As String
Dim iRango As Range, dRango As Range
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Creamos ventana de diálogo para seleccionar ruta al directorio o carpeta
On Error Resume Next
With CreateObject("shell.application")
path = .browseforfolder(0, Titulo, 0).Items.Item.path
End With: On Error GoTo 0
If path = Empty Then
Exit Sub
End If
'Determinamos a partir de que fila vamos a consolidar los datos
'Normalmente fila 2 si tenemos encabezados de columna
FilaInicio = 2
'Desactivamos actualizacion de pantalla y eventos
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Identificamos el nombre de nuestro libro
MiLibro = ThisWorkbook.Name
'Limpiamos datos en la hoja "AGRUPADO" para actualizar la informacion
ThisWorkbook.Sheets("AGRUPADO").Range("A2:H65000").ClearContents
'Indicamos la hoja de destino de los datos que queremos consolidar
Set Hoja_Destino = ThisWorkbook.Sheets("AGRUPADO")
'Identificamos y listamos los archivos Excel en el directorio (por orden de fecha de modificación)
iArchivo = Dir(path & "\*.xl*", vbNormal)
'Si la longitud del archivo es cero, salimos del proceso (no existe archivo para consolidar)
If Len(iArchivo) = 0 Then Exit Sub
' Mientras el largo del archivo sea mayor de 0 iniciamos el proceso
Do While Len(iArchivo) > 0
'Si el nombre del archivo no es igual a nuestro libro seguimos el proceso
If Not iArchivo = MiLibro Then
'Capturamos ruta al iarchivo
Set iLibro = Workbooks.Open(Filename:=path & "\" & iArchivo)
'Contamos las hojas que tiene
fin = iLibro.Sheets.Count
'Iniciamos un bucle por cada hoja, donde seleccionamos los datos desde la fila 2
'hasta el final de la hoja (siempre sin filas en blanco)
'Luego copiamos los datos en la Hoja_Destino, que es la Hoja "AGRUPADO"
'Colocándolos al final de los rangos que se vayan pegando
For i = 1 To fin
iLibro.Sheets(i).Select
Set iRango = iLibro.Sheets(i).Range(Cells(FilaInicio, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1)
iRango.Copy
dRango.PasteSpecial xlPasteValues
Next
'Cerramos el libro y continuamos el proceso
Application.CutCopyMode = False
iLibro.Close False
End If
iArchivo = Dir()
Loop
' Si queremos podemos ordenar la información consolidada, en este caso por ID.
' Podemos obviar esta parte si no necesitamos ordenar los datos.
With ThisWorkbook.Sheets("AGRUPADO")
D_fin = Application.CountA(.Range("A:A"))
.Range("A1:G" & D_fin).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Range("A1").Select
.Columns.AutoFit
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
' Una vez finalizado, lanzamos mensaje de finalización.
MsgBox ("EL PROCESO HA FINALIZADO CORRECTAMENTE"), vbInformation, "PROCESO DE CONSOLIDACIÓN"
End Sub

Como podéis observar, he incluido un buscador de directorios o carpetas de forma que no sea necesario modificar la macro para hacer referencia a la ruta de los archivos.

With CreateObject("shell.application")
path = .browseforfolder(0, Titulo, 0).Items.Item.path

Tan solo hay que seleccionar la carpeta donde los hemos guardado. El resto de la macro, lo voy explicando en el propio archivo.

Sí que me gustaría comentar lo siguiente, para indexar los archivos tipo Excel (*xl*) que vamos a consolidar he utilizado la función Dir().

iArchivo = Dir(path & "\*.xl*", vbNormal)

Efectivamente, lista los archivos que iremos procesando y lo hace correctamente. Sin embargo, en caso que necesitásemos que se fueran procesando ordenados por nombre, no podríamos hacerlo, la función ordena según la fecha de modificación del archivo, de la más antigua a la más reciente. Por ello, si los archivos que queremos consolidar han de llevar un cierto orden se debe tener en cuenta la fecha de modificación.

Para solucionar esta limitación de la función DIR(), al final de la macro, he añadido una pequeña instrucción que nos ordenará la hoja “AGRUPADO” por, por ejemplo, el ID. Y así tendremos los datos en orden.

Si no necesitáis que estén ordenados, simplemente elimináis la última parte:

D_fin = Application.CountA(.Range("A:A"))
.Range("A1:G" & D_fin).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Pues esta ha sido la entrada de hoy, espero que os resulte de tanta utilidad como a mi (y os ahorre tiempo).

Os dejo el archivo de la macro.

Descarga el archivo de ejemplo pulsando en: CONSOLIDAR INFORMACIÓN DE VARIOS ARCHIVOS EN UNA HOJA EXCEL CON VBA

Y aquí la carpeta de ejemplo con los 3 archivos (esta en Drive, dado que en WordPress no se permite subir carpetas al servidor):  ARCHIVOS DE EJEMPLO PARA PRUEBAS

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

ELIMINAR TODAS LAS IMÁGENES (FORMAS) DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

Hace unos días recibí una consulta sobre cómo se podría modificar el tamaño de todas las imágenes de una hoja o de un libro mediante una macro.

Aunque este tema ha sido muy tratado en diferentes webs y foros de internet, me ha parecido útil escribir un post acerca del tratamiento de imágenes (o mejor, de cualquier objeto de la colección shapes).

Es decir, en Excel podemos estar trabajando con una fotografía, un organigrama de SmarArt, un gráfico o un objeto Ole, etc).  Todo ellos objetos que forman parte de la colección Shapes.

Siguiendo un caso práctico, imaginad que tenemos un libro con las siguientes formas (imágenes, autoformas, llamadas, objeto SmartArt):

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

Dicho esto, si quisiéramos eliminar todos los objetos de la primera hoja de nuestro libro, lo haríamos así:

Sub Borrar_Hoja()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
.Delete
End With
Next
End Sub

Si quisiéramos eliminar todas las formas (Shapes) que existen el libro, tendríamos que utilizar la macro anterior pero dentro de un bucle for – next que recorra todas las hojas del libro:

Sub Borrar_Libro()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos todas las formas
For Each Shapes In Sheets(i).Shapes
'y las borramos
With Shapes
.Delete
End With
Next
Next i
End Sub

Sin embargo, si solo queremos eliminar un tipo de forma, tendríamos que especificar en el código el tipo que deseamos eliminar. Antes de seguir, os dejo un enlace a Microsoft donde se especifica el nombre y valor de todas las formas de la colección shapes:

https://msdn.microsoft.com/en-us/library/office/ff860759.aspx

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba1

*en el caso del valor 24, como observaréis, he modificado el Name que aparece publicado en Microsoft en el enlace de Microsoft (msoIgxGraphic) por (msoSmartArt), el motivo es que he probado el nombre msoIgxGraphic en todas las versiones desde 2010 en adelante y no funciona, pero sí lo hace con msoSmartArt.

Por lo tanto, para realizar la prueba vamos a elegir un tipo determinado de forma a eliminar, tanto en la primera hoja como en todo el libro. La elección serán las fotografías, que equivalen según el cuadro anterior a msoPicture y con valor 13.

Para eliminar las fotografías de la primera hoja, usaremos el siguiente código:

Sub Borrar_Hoja_Tipo()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
End Sub

Y para eliminar las fotografías en todo el libro, usaremos el siguiente:

Sub Borrar_Libro_Tipo()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos/detectamos todas las formas
For Each Shapes In Sheets(i).Shapes
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
Next i
End Sub

El resultado después de aplicar la macro sería este:

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba2

Y hemos eliminado las fotografías en todo el libro.

Evidentemente, podemos utilizar las macros para cualquier otro tipo de acción sobre las formas, como por ejemplo darle formato, colores, alto, ancho, etc … Pero para este ejemplo, nos hemos limitado a eliminar (en otros post que tengo pensado ir publicando iremos trabajando otras acciones).

En el archivo adjunto os dejo las macros. Sin embargo los botones que he dejado para ejecutarlas, solo son para los casos donde determinamos el tipo de forma a eliminar. Las macros que eliminan todas las formas de la hoja y del libro, si pusiese un botón en la hoja, directamente lo eliminaría, dado que también se trata de una forma (control de formulario).

Espero que os sea de utilidad🙂

Descarga el archivo de ejemplo pulsando en: ELIMINAR TODAS LAS IMÁGENES DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

combinar-correspondencia-en-excel-y-guardar-en-pdf4

COMBINAR CORRESPONDENCIA EN EXCEL Y GUARDAR EN PDF

Hola a todos!, espero que todo os vaya bien🙂

Llevo varias semanas que no publico nuevo material, el motivo no es otro que la falta de tiempo. Lo cierto es que entre la temporada veraniega, la reincorporación al trabajo y temas pendientes, se hace complicado sacar un momento para escribir nuevas entradas.

Estos días sin embargo, tuve tiempo para preparar un post bastante interesante. Como suele ser habitual, el tema surgió a raíz de una consulta de una lector. Me preguntaba acerca de la posibilidad de realizar combinar correspondencia en Excel y poder pasar cada uno de los documentos a PDF de forma individual.

Normalmente, el proceso de combinar correspondencia se inicia desde Microsoft Word y se accede a Excel para buscar la base de datos en la que tenemos la información necesaria para enviar la correspondencia. Prácticamente se pueden realizar todo tipo de envíos masivos y enviar la información a través de correo electrónico. También se pueden imprimir los documentos (es posible que con paciencia se puedan imprimir con algún programa a PDF de uno en uno, especificándolo en el cuadro de diálogo de la impresora).
Para más información sobre combinar correspondencia os dejo el siguiente enlace: COMBINAR CORRESPONDENCIA

Pues bien, en casi la totalidad de los casos podremos solucionar nuestras necesidades con Word. Pero si queremos pasar cada uno de los archivos que queremos enviar a PDF y guardarlos en un directorio, Excel es una buena solución. Para hacerlo, debemos construir nuestra propia aplicación de combinar correspondencia.

Después de este pequeño comentario, ya estamos listos para comenzar. Como siempre, vamos a ver la base de datos que hemos confeccionado para enviarles una comunicación, pestaña “DATOS”:

combinar-correspondencia-en-excel-y-guardar-en-pdf

El siguiente paso ahora es crear la plantilla que vamos a utilizar para incorporar los datos a enviar. La plantilla la vamos a crear directamente en una hoja Excel, lo haremos teniendo en cuenta los formatos que podemos darle al texto en cada línea de la hoja, y además crearemos una serie de marcadores que luego vamos a utilizar para trasladar los datos de cada persona. Esta es la plantilla:

combinar-correspondencia-en-excel-y-guardar-en-pdf1

Como podéis observar, aquellos campos que hacen referencia a los datos que iremos incorporando en cada carta los marcaremos entre corchetes “<>”, luego en la macro haremos referencia a ellos para reemplazarlos.

Es importante que vayáis configurando en cada línea lo datos de la forma en la que saldrán finalmente, aunque esto lo podéis hacer realizando varias pruebas para depurar el diseño.

La plantilla “GENERAR” no contiene datos, será la hoja en la que se vuelque una copia de “PLANTILLA” y en la que iremos colocando cada registro de la hoja “DATOS”. Lo que sí es importante es que en la hoja “GENERAR”, las líneas y las columnas tengan en mismo ancho que la hoja “PLANTILLA”, o por lo menos tener en cuenta que el PDF final tendrá el mismo formato que la hoja “GENERAR”:

combinar-correspondencia-en-excel-y-guardar-en-pdf2

Ahora que ya tenemos la carta incorporada en nuestro archivo y las hojas creadas, ya podemos ir a la programación, debemos incluir esta macro:

Sub COMBINAR_CORRESPONDENCIA()
Dim i As Double
Dim ruta As String
Application.ScreenUpdating = False
'Activamos nuestro libro
ThisWorkbook.Activate
Sheets(2).Name = "GENERAR"
'seleccionamos hoja "GENERAR"
Sheets("GENERAR").Select
'Contamos el número de casos
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Elegimos la carpeta donde queremos guardar los archivos
On Error Resume Next
With CreateObject("shell.application")
ruta = .browseforfolder(0, Titulo, 0).Items.Item.Path
End With: On Error GoTo 0
'Si no elegimos la carpeta de destino, la macro se para
If ruta = Empty Then
MsgBox "DEBES SELECCIONAR UNA CARPETA DE DESTINO, PULSA DE NUEVO EL BOTÓN GENERAR", vbExclamation
Exit Sub
End If
'Iniciamos un for
For i = 2 To Fin
'Creamos variables para cada uno de los datos a incorporar en la hoja "GENERAR"
Nombre = Sheets("DATOS").Cells(i, 1)
Apellidos = Sheets("DATOS").Cells(i, 2)
Lugar = Sheets("DATOS").Cells(i, 3)
Fecha = Format(Sheets("DATOS").Cells(i, 4), "[$-C0A]d ""de"" mmmm ""de"" yyyy;@")
ExcelSignum = Sheets("DATOS").Cells(i, 5)
Email = Sheets("DATOS").Cells(i, 6)
Firma = Sheets("DATOS").Cells(i, 7)
'Llamamos a la macro Actualiza
Call ACTUALIZA
'Damos nombre a la hoja activa, que es GENERAR
ActiveSheet.Name = Sheets("DATOS").Cells(i, 1) & " " & Sheets("DATOS").Cells(i, 2)
With ActiveSheet
'Reemplazamos los datos en los marcadores que hemos creado en Plantilla
Cells.Replace What:="<NOMBRE>", Replacement:=Nombre, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<APELLIDO>", Replacement:=Apellidos, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<LUGAR>", Replacement:=Lugar, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<FECHA>", Replacement:=Fecha, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<EXCEL SIGNUM>", Replacement:=ExcelSignum, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<EMAIL>", Replacement:=Email, LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="<FIRMA>", Replacement:=Firma, LookAt:=xlPart, SearchOrder:=xlByRows
'Si queréis dar formato de hipervínculo a las celdas A6 y A10
'Solo tenéis que descomentar la parte indicada entre puntos:
'-----------------------------------------------------------
.Range("A6,A10").Select
With Selection
.Font.Color = RGB(0, 0, 255)
.Font.Underline = xlUnderlineStyleSingle
End With
'-----------------------------------------------------------
End With
'Publicamos en PDF, sin propiedades en el documento y sin abrir cada vez que se genere el PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta & "\" & ActiveSheet.Name, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Volvemos a renombrar la hoja2 como "GENERAR"
Sheets(2).Name = "GENERAR"
Next
End Sub

Con esta macro debemos adjuntar esta otra, a la que hacemos referencia en la macro principal:

Sub ACTUALIZA()
Dim Shape As Excel.Shape
'Limpiamos contenidos en hoja "GENERAR"
Sheets("GENERAR").Select
Columns("A:A").ClearContents
'Eliminamos imagenes en la hoja Generar
For Each Shape In Sheets("GENERAR").Shapes
Shape.Delete
Next
'Copiamos la plantilla base desde la hoja "PLANTILLA" a "GENERAR"
'Seleccionamos el rango de FILAS hasta donde tenemos texto o un rango superior
Sheets("PLANTILLA").Select
Rows("1:50").Select
Selection.Copy
Sheets("GENERAR").Select
Rows("1:50").Select
ActiveSheet.Paste
End Sub

Cuando la macro se ejecute, directamente nos va a preguntar por una ubicación (directorio) en la que queremos guardar cada uno de los PDF generados. Si no elegimos, saldremos la macro y se parará el proceso. Si la elegimos, la macro pasará los datos a la hoja “GENERAR” mediante el comando reemplazar y sustituirá cada uno de registros marcados a través de un bucle for-next.

La otra macro, lo que hace es limpiar de todo contenido la hoja “GENERAR” incluso objetos, como firmas escaneadas, imágenes, logos, etc y traslada el texto de la hoja “PLANTILLA”.

Finalmente, guardamos la hoja “GENERAR” denominando a cada PDF con el nombre de las personas, el resultado es este:

combinar-correspondencia-en-excel-y-guardar-en-pdf3

y la comunicación esta:

combinar-correspondencia-en-excel-y-guardar-en-pdf4

De esta forma tendremos todos los archivos en PDF y guardados en el mismo directorio.

En la macro, os he dejado parte del código comentado, ese código sirve para dar formato a los hipervínculos que se mostrarán en el PDF si queremos que se destaquen en azul y subrayados. Es solo una medida puramente estética, el hipervínculo funciona perfectamente.

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

Importante: la macro ha sido probada en Excel 2010, 2013 y 2016. En 2007 debería funcionar correctamente, dado que permite pasar documentos a PDF. En versiones anteriores no funcionará.

Descarga el archivo de ejemplo pulsando en: COMBINAR CORRESPONDENCIA EN EXCEL Y GUARDAR PDF

 

crear-nombre-definido-en-excel-con-vba3

CREAR NOMBRE DEFINIDO EN EXCEL CON VBA

Hace unos días recibí una breve consulta acerca de cómo crear y actualizar un nombre definido en Excel mediante VBA.

Dado que la petición me pareció interesante, he desarrollado una pequeña macro que añade o actualiza nombres definidos en la macro.

Pero antes de entrar en el código, vemos los datos que nos van a servir de ejemplo, realizaremos el ejercicio con la base de datos habitual que suelo utilizar de ejemplo, empleados de unos grandes almacenes:

CONECTAR BASE DE DATOS DE EXCEL_1

Los nombres definidos se pueden crear de dos formas o métodos:

1 – Crear nombre definido desde la selección: donde Excel crea automáticamente el nombre a partir de los datos que tengamos seleccionados en la hoja Excel. Este es el comando:

crear-nombre-definido-en-excel-con-vba1

Además permite crear el nombre a partir de los valores de la primera fila, la última fila, la columna izquierda o la columna derecha. Además en caso de que el nombre definido (nombre) tenga espacios o empiece por un carácter numérico, automáticamente añade un carácter de subrayado “_”.

Para este método 1 vamos a utilizar la siguiente macro:

Sub NombresDefinidos_metodo1()
Dim i As Double
Sheets("DATOS").Select
With Sheets("DATOS")
'Contamos las columnas con datos sobre las que crear el nombre definido
Fin = Application.CountA(Worksheets("DATOS").Range("1:1"))
'Desactivamos las notificaciones al actualizar los nombres
Application.DisplayAlerts = False
'Mediante un "for" creamos nombre definido por cada columna
For i = 1 To Fin
Range(Cells(1, i), Cells(1, i).End(xlDown)).Select
Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
False
Next
'Activamos las notificaciones
Application.DisplayAlerts = True
End With
End Sub

2 – Crear nombre definido asignándolo manualmente: los nombres definidos también se pueden crear de forma manual especificando nombre, ámbito (hoja o libro) y rango. Esto se realiza a través de este comando:

crear-nombre-definido-en-excel-con-vba2

En este caso, el sistema no formatea el nombre con el carácter “_” sino que debes introducirlo tú directamente en caso de que la palabra que define al nombre contenga espacios o empiece por un número.

Para este método vamos a utilizar la siguiente macro:

Sub NombresDefinidos_metodo2()
'Declaramos las variables
Dim Nombre As String
Dim Seleccion As Range
'Con la hoja activa
With ActiveSheet
'Contamos las columnas
Fin = Application.CountA(.Range("1:1"))
'Iniciamos un "for" seleccionamos rangos de las columnas a partir de la segunda
'fila
For i = 1 To Fin
Set Seleccion = Range(Cells(2, i), Cells(2, i).End(xlDown))
'Si el nombre tiene espacios los sustituimos por "_"
Nombre = Application.WorksheetFunction.Substitute(.Cells(1, i).Value, " ", "_")
'Si el nombre comienza por número anteponemos un "_" (caracter subrayado)
If Mid(Nombre, 1, 1) = IsNumeric(Mid(Nombre, 1, 1)) Then
Nombre = "_" & Nombre
End If
'Agregamos nombre definido, o bien al libro o a la página
ActiveSheet.Names.Add Name:=Nombre, RefersTo:=Seleccion
Next
End With
End Sub

Como podéis observar he introducido unas líneas en el código para formatear el nombre en caso de espacios o de empezar por un número:

'Si el nombre tiene espacios los sustituimos por "_"
Nombre = Application.WorksheetFunction.Substitute(.Cells(1, i).Value, " ", "_")
'Si el nombre comienza por número anteponemos un "_" (caracter subrayado)
If Mid(Nombre, 1, 1) = IsNumeric(Mid(Nombre, 1, 1)) Then
Nombre = "_" & Nombre
End If

Para finalizar, me gustaría añadir una tercera macro que puede resultar de utilidad, un código que borra todos los nombres definidos de nuestro proyecto. La dejo en el archivo en otro módulo (aunque se puede introducir en las macros anteriores con un “Call” para que se ejecute en el mismo proceso):

Sub Elimina_nombres()
Dim Nombre As Name
'Por cada nombre definido en el libro, lo eliminamos.
For Each Nombre In ActiveWorkbook.Names
Nombre.Delete
Next Nombre
End Sub

En resumen, en ambos casos podemos añadir automáticamente nombres definidos al libro que estamos utilizando, pero solo en la segunda macro vamos a poder especificar si queremos que el ámbito del nombre sea el libro o la hoja (activa).

Este es el resultado de aplicar cualquiera de las dos macros:

crear-nombre-definido-en-excel-con-vba3

Y con estas dos macros ya podemos añadir y actualizar nombres definidos a nuestra hoja o libro Excel🙂

Descarga el archivo de ejemplo pulsando en: CREAR NOMBRE DEFINIDO EN EXCEL CON VBA