martes, 19 de diciembre de 2017

Gestor de archivos con excel. Buscar, encontrar, coincidir. Nuestro propio filtro avanzado en excel. Preliminar




Sigo sin ideas. El otro día hablando con un amigo me comentó que el utiliza un programa que le permite seleccionar fotos según unos atributos que el mismo les asigna. Además de arquitecto, diseña y construye muebles. A cada mueble construido le saca varias fotos para documentar el trabajo y, como es lógico, le interesa poder consultar en sus archivos por tipo de mueble, no solo por fecha o nombre. Asigna un tipo de mueble a cada foto, pueden ser varios atributos los asignados, tantos como se consideren necesarios para poder buscarlos por tipo de mueble.

Voy a hacer un gestor similar, solo con excel. Tengo, como muchísima gente, miles de fotos digitales en origen y unos cuantos cientos escaneadas. En las fotos digitales la fecha en la que se hicieron suele coincidir con la fecha que aparece en los listados. En las escaneadas no, la fecha de escaneo normalmente es muy posterior a la de realización de la foto. Podemos asignar un atributo "fecha de la foto" distinto al de fecha de los listados. Podemos asignar atributos tales como lugar, como familia, como amigos, etc...

Fase 1: Llevar a excel los nombres de las fotos:
  • Recupero el viejo D.O.S. Con el viejo comando dir obtengo un fichero con todos los "jpg" que tengo en mi directorio "Fotos", redireccionando la salida a un fichero de texto.
  • Creo un fichero ejecutable ".bat" (con notepad) con la siguiente instrucción: dir c:\DiscoWindowsXp\fotos\*.jpg /s /o /-C  > Imagenes.txt
  • Si quisiese añadir otro tipo de fichero añadiría una línea por tipo de fichero (dir c:\DiscoWindowsXp\fotos\*.gif /s /o /-C >> Imagenes.txt)
  • Esto nos da, me da en mi instalación, un fichero de texto con la siguiente estructura:



 Directorio de c:\DiscoWindowsXp\fotos\20121201 Confirmacion


01/12/2012  21:44           1407193 IMG_5543.JPG
01/12/2012  21:44           1467596 IMG_5544.JPG
              42 archivos 

En esta estructura  aparece una línea con el directorio y n líneas con el nombre, y otros atributos, de los ficheros. Debemos pasar de esta estructura a otra en la que en cada línea aparezca, además, el directorio, y que además elimine las líneas vacías.

  • Abro  excel. Desde excel abro el fichero de texto. En el momento de la apertura seleccionamos "Ancho fijo" y en origen del archivo "MS-DOS".
  • En la siguiente pantalla eliminamos todas las posibles divisiones. Vamos a importar los datos sin dividir.
  • En la tercera pantalla importamos los datos como "Texto". Finalizamos.
Adición del directorio al resto de las líneas:

  • La cosa consiste en identificar las líneas que empiezan por "Directorio ".
  • En el caso de que empiece por "Directorio" obtenemos el nombre del directorio y, si no, mantenemos el nombre obtenido anteriormente. 
  • Nos situamos en b2 y escribimos =SI(IZQUIERDA($A2;10)="Directorio";EXTRAE($A2;15;200);$B1)
  • Como quiero filtrar los directorios, en c2 ponemos y arrastramos la siguiente instrucción: =SI(IZQUIERDA($A2;10)="Directorio";$C1+1;$C1) Si los 10 caracteres de las izquierda son iguales a directorio, suma uno al valor anterior, si no mantén el valor anterior
  • Con esa instrucción pongo un número a cada directorio. 
  • Para numerar las fotos utilizamos la siguiente fórmula, en D2: =SI(MINUSC(DERECHA($A2;4))=".jpg";$D1+1;$D1)
  • Numeramos todas las líneas en E. Ponemos un 1 en E1, un dos en E2, seleccionamos ambas celdas y arrastramos.
Solo imágenes:
  • Insertamos una nueva hoja, "JPG" Copiamos la columna E en "JPG" A1, de momento no vamos a colocar cabeceras. 
  • Con el administrador de nombres creamos el rango con nombre "Datos". Con este nombre haremos referencia a al rango utilizado en la hoja "Imagenes", =Imagenes!$A:$E
  • Ya en JPG colocamos en b1 =COINCIDIR(JPG!$A1;Imagenes!D:D;0) Es decir buscamos el valor A1 en la columna D de Imagenes. Casi deberíamos incluir la gestión de errores pero de momento no es imprescindible. Arrastramos hasta el final.
  • En C1, en la columna C, situamos el directorio utilizando =SI.ERROR(INDICE(Datos;$B1;2);""). En este caso además controlamos el posible error con la función SI.ERROR() Si se produjera un error devuelve "". Arrastramos.
  • En D, utilizando =SI.ERROR(INDICE(Datos;$B1;1);"") traemos los nombres de los ficheros y su fecha y tamaño.
  • Esto es un paso intermedio, podemos separar fecha y nombre sin realizar este paso pero queda mas claro si se hace este paso intermedio. Evitemos, en lo posible, formulones.
  • En E1 situamos la fecha del fichero con =IZQUIERDA($D1;17). Arrastramos
  • Por último en F separamos el nombre y limpiamos de los espacios que preceden al nombre con =ESPACIOS(EXTRAE($D1;19;255)). Arrastramos
  • Podemos, si así lo consideramos, separar el año, el mes y el día de la fecha. Como, de momento la fecha está en modo texto, podemos convertirla a modo fecha. Basta sumarle 0 para convertirla. Gestionando el posible error, =SI.ERROR(E1+0;"")
  • Tanto si hemos pasada la fecha de texto a número como si no podemos utilizar las funciones DIA(E1), MES(E1), Año(G1), Hora(G1) y Minuto(G1). Gestionamos el posible error con SI.Error(). Arrastraríamos para completar la página.
Nombre de los directorios.
  • Insertamos una nueva hoja, la hoja "Dir".
  • Copiamos o llenamos la columna A con los 500 primeros números (+-)
  • Buscamos la primera ocurrencia del ordinal de la columna a en la columna C de "Imagenes" con =SI.ERROR(COINCIDIR(JPG!$A1;Imagenes!C:C;0);""). Esta vez si gestionamos el posible error. Arrastramos.
  • Obtenemos el nombre con =SI.ERROR(INDICE(Datos;$B1;2);"").
  • Vemos que como partimos de de un comando DOS tenemos problemas con la Ñ,ñ y con alguna vocal acentuada. 
  • Copiamos el carácter que sustituye a la Ñ (en "Imagenes" y procedemos a reemplazar en la hoja "Imagenes", columna A, ese carácter por "ñ".
  • Repetimos la operación para los otros posibles caracteres mal representados.
  • Ya tenemos separados, por columnas los atributos que nos interesan, pero, tenemos un libro excel cargadísimo de fórmulas que nos pueden causar problemas en un futuro.
Por tanto creo que debemos pasar los datos separados, copiando los valores solamente, a un nuevo libro
  • Creamos un nuevo libro.
  • Añadimos las hojas "JPG" y "Dir"
  • Vamos al libro procesado y copiamos los datos que nos interesen de los datos  obtenidos. En mi caso lo copio todo, ya eliminaré lo que tenga que eliminar. 
  • Copio JPG. Voy a la imagen, selecciono A1 y elijo "pegado especial". Seleccionamos "Valor".
  • Damos formato de fecha a la columna fecha
  • Lo mismo para Dir.
  • Insertamos una línea para incluir cabeceras. Eliminamos si fuese preciso alguna columna o alguna fila con errores.

¡Bien! ya tenemos importados a nuestra aplicación los datos que queremos gestionar. Ahora viene el pesadisimo  trabajo manual en el que tendríamos que poner, foto a foto, aquellos atributos que definen cada foto. Como tenemos agrupadas las fotos por directorio y es muy probable que todas las fotos de un mismo directorio tengan los mismos atributos, dividimos los atributos en "atributos del directorio" y "atributos de la foto". Los atributos del directorio los añadimos en la hoja de directorios y los otros en la hoja de JPG. Como hemos asignado unos atributos genéricos al directorio que afectan a todos los ficheros puede que resulte interesante definir un "no atributo" con el fin de excluir alguno de de los atributos de directorio de algún ficheros en concreto. 
A partir de aquí deberíamos de cambiar de plataforma, pasar los datos a una base de datos y trabajar con access en vez de excel, pero aun se pueden obtener resultados aceptables en excel.
  • Los atributos, en este caso, son texto separado por comas. Se puede hacer de otra manera, que cada cual se lo piense. 
  • Como estoy escribiendo un "preliminar" y veo que además el libro excel se está volviendo demasiado pesado, hay miles y miles de formulas,  no voy a desarrollar completamente la idea Me voy a limitar a encontrar un par de textos diferentes dentro del nombre del directorio y/o dentro de los atributos de directorio. De momento no voy a buscar ni por fechas ni por tamaños ni por atributos de fichero. Quizás lo desarrolle posteriormente
  • Asigno los atributos de algunos directorios en la página "Dir". Texto separado por comas. Estos atributos son texto del tipo "montaña", "vacaciones", "móvil", nombre de algún amigo, etc...
  • En la página "Buscar" dedicamos las celdas A2 y A3 para introducir los textos a buscar. En A5 indicamos si queremos que los textos buscados estén los dos en los atributos o con que este uno solo de ellos basta. Tiene dos valores válidos, "S" o "N", si o no.
  • Creamos un par de variables con nombre, Busca1 y Busca2, textos a buscar, referentes a Buscar!A2 y Buscar!A3.
  • Volvemos a la página "Dir". Como la segunda cadena de búsqueda es opcional, si no existiese la igualo a la primera., ver las celdas C1 y C2. Como puede hacerse directamente con variables con nombre creo la variable Busca3 y trabajo con ella =SI(Busca2<>"";MINUSC(Busca2);MINUSC(Busca1)).
  • Con este sencillo truco me evito varias columnas de fórmulas. Además trato las cadenas de texto en minúsculas, también facilita mucho la vida.
  • En las columnas C y D buscamos en la concatenación del nombre del directorio y de los atributos el primer y segundo texto a localizar con =SI.ERROR(ENCONTRAR( Busca1;MINUSC($A4 & "," & $B4 & ",");1);0).
  • En las columnas E y F utilizamos las funciones Y() y O() para conocer si al menos uno de los textos buscados esta presente o si ambos lo están.
  • Como ya he comentado, una vez que tenemos importados y procesados los datos a la hoja excel deberíamos continuar pasando los datos a una base de datos, tipo access,  y continuar el trajo con la B.D. En este punto debemos hacer un "JOIN" con los directorios y los ficheros JPG. Entre la hoja Dir y la hoja JPG.
  • Primero buscamos, y encontramos, el directorio de JPG en la relación de directorios de Dir con =COINCIDIR(JPG!B2;Dir!A:A;0) en la columna K. 
  • El valor encontrado nos permite pasar de Dir a JPG los distintos campos del JOIN con =INDICE(Dir!B:B;$K2)
  • En la columna P numeramos los registros que cumplen la/las condiciones pedidas con =SI(SI(AmbosN="S";$O2;$N2);P1+1;P1).
  • Volvemos a la hoja "Buscar". En la columna B hemos copiado la numeración de uno a n, donde n es el número máximo de registros esperados. Si nos hubiésemos quedado cortos ampliamos numeración y arrastramos las formulas
  • Buscamos el ordinal (1,2,3,4...) en la columna P de JPG. Con este número obtenemos los distintos campos a presentar con =SI.ERROR(INDICE(JPG!B:B;Buscar!$C2) & "\";"")
  • Tanto la columna P de JPG, como el área de datos de JPG deberíamos referenciarlas con una variable con nombre. 
  • Para terminar escribimos un código html que lo podemos pasar a una página htm.
  • =SI(E2<>"";"<br><a href=" &CARACTER(34) & D2& E2 &CARACTER(34)& " target=foto>"  & D2& E2 & "</a>";"")
  • Pasamos este código, es un copia-pega manual, abrimos la página y ya tenemos un enlace a todas las fotos que cumplen las condiciones pedidas. 
  • Si queremos completar, dar un acabado perfecto, ya tendríamos que pasar a programación.






jueves, 7 de diciembre de 2017

Automatizar respuestas a un formulario de Google con Excel. Preliminar.

En un principio la idea de automatizar respuestas a un formulario de google me surgió en uno de mis trabajos con Arduino Yun. Parto del supuesto de que necesito medir remotamente unos determinados parámetros. Leo, envío a la nube los valores medidos y puedo consultarlos desde cualquier sitio (incluido mi móvil).
Me quedé sin ideas y dejé de hacer cosas con arduino. El otro día en una sobremesa estuvimos hablando de IPs estaticas e IPsdinámicas, si se podía hacer esto o no hacerlo, que si te cambia la IP no puedes pensar en establecer tu propia red, etc...

Me surgió la pregunta ¿puedo conocer remotamente la IP dinámica de mi instalación desde cualquier sitio? Después de pensarlo, después de hacer unas cuantas  pruebas recuperé la vieja idea de automatizar respuestas a un formulario.
  • Obtengo la IP. Es fácil. De momento, estoy en los preliminares, la leo de una de las páginas web que me dan ese servicio (www.cualesmiip.com). 
  • Esta lectura la puedo hacer automaticamente abriendo www.cualesmiip.com desde vbasic como si fuera un libro excel mas.
  • Workbooks.Open Filename:="http://www.cualesmiip.com/"
  • Hecho esto, en principio, la dirección IP aparece en la celda A31.
  • Esto no quiere decir que siempre vaya a ser así, la página web puede ser modificada en cualquier momento.
Creo un formulario google, con salida a una hoja de cálculo:


Si quiero automatizar el envío de un formulario necesito conocer tanto la acción que se ejecuta al pulsar "Envío" como el nombre de los distintos campos de pregunta. Son nombres internos que hay que buscar en el código fuente del formulario:
  • El la inmensa sopa de letras que supone el código fuente de un formulario encontrar la acción y los nombres de las preguntas parece imposible pero es relativamente sencillo. 




Una vez encontrados acción y preguntas lo llevamos un código vbasic, como el siguiente:



Sub DireccionIP()

Dim IP, NL, Accion, Prg1, Prg2, Lin

'
' Abrimos y obtenemos IP de www.cualesmiip
'
    Workbooks.Open Filename:="http://www.cualesmiip.com/"
  IP = ActiveSheet.Range("a31").Value
    ActiveWindow.Close
'Preparamos respuesta al formulario
Accion = "https://docs.google.com/forms/d/e/1FAIpQLScChBMMMdog1LT4leKk2WF0DDd32-aeWLll57YjVVjvBvJGhw/formResponse?"
Prg1 = "entry.1464650708=" & IP
Prg2 = "entry.1464650708=" & Now()


Lin = Accion & Prg1 & "&" & Prg2

'enviamos la acción

    Workbooks.Open Filename:=Lin
  ActiveWindow.Close
    
End Sub


  • Ya solo queda comprobar que el envío se ha realizado. Voy a mi google drive, abro la hoja de cálculo que he creado para contener las repuestas y veo que si se ha producido el envío. 
  • Por triplicado, de momento no se por que, pero ahí está la dirección IP pedida.
  • Como estoy en los preliminares, me doy casi por satisfecho, aunque el resultado presente varios defectos y falte casi totalmente el desarrollo de la idea, he conseguido enviar vía excel la dirección IP obtenida en www.cualesmiip.com a mi google drive. Ya la tengo en red, ya puedo consultarla desde cualquier sitio. De momento se que se puede hacer de un modo relativamente sencillo.



jueves, 23 de noviembre de 2017

Excel y Access. Trabajar datos en excel con consultas access.

http://ellibrosobreexcelquenoescribirenunca.blogspot.com.es/2012/02/funciones-de-busqueda-buscarbuscarv-y.html



Ha llegado a mis manos un libro excel para determinar el conocimiento que tiene de excel un empleado de una multinacional. Llevo mucho tiempo sin publicar en este blog, por falta de ideas, pero con el ese libro excel me ha llegado una idea, ¿cuando tengo que hacer un informe en excel, puedo utilizar otros medios que me faciliten el trabajo? Por supuesto. Tenemos una infinidad de utilidades, gratuitas o de pago que podemos utilizar sin ningún escrúpulo, siempre y cuando nos facilite de verdad el trabajo.
Esta vez voy a obtener un informe, a partir de unos datos incluidos en una hoja excel, con consultas access.
El libro excel recibido, en principio, parece un poco desordenado, por una cuestión de criterios yo considero que datos e informes no deben estar en la misma hoja. Intentemos "despejar" el tema, no creemos confusión.
  • Separo los datos en una hoja independiente
  • Creo una B.D. access en blanco.
  • Vinculo, no importo, la hoja con los datos a una tabla de esa B.D.
  • Los datos son datos trimestrales, son un informe de productos vendidos por trimestre. 
  • A su vez los productos vendidos están agrupados por producto propiamente dicho y categoría de producto.
  • El informe a realizar es un informe sobre la venta por categorías y por trimestre.
  • Por lo tanto, hay que agrupar todos los productos de la misma categoría en una sola línea y sumar los totales por trimestre y año en diferentes columnas.


CATEGORIA
T1 T2 T3 T4
Bebidas 42.751,70 24.054,80 26.312,90 38.129,40
Condimentos 17.002,80 9.663,80 9.075,50 10.920,90
Repostería 22.694,40 19.548,90 26.183,80 25.004,40
Lácteos 78.494,10 44.976,90 39.050,40 56.020,90
Pastas/Cereales 15.759,50 19.131,00 11.888,20 16.023,40
Carnes 33.907,60 24.275,40 16.577,20 22.038,00
Elaborados 11.905,90 8.440,00 11.866,80 11.798,70
Pescados/Mariscos 45.879,00 20.311,70 22.188,40 33.123,60


Como ya he dicho, primero creo una B.D. en blanco y vinculo los datos excel con esa B.D. Una vez vinculados los datos con la B.D. solamente voy a trabajar con consultas acces.


  • Las consultas que voy a utilizar, salvo una, son consultas elementales, escritas directamente  con sentencias SQL.
  • Segundo paso: Cada registro de la tabla "Datos" está formado por el campo "producto", el campo "categoria", el campo trimestre "Trim" y el campo "Importe". Como paso intermedio a la obtención del informe, aunque se puede hacer directamente sin pasar por este paso intermedio, creo una consulta que coloca los distintos importes en la columna que se corresponde con su trimestre, según el informe a obtener. Paso el campo trimestral único a un campo (una columna) para cada trimestre y una columna mas para el total año. Esta es una consulta intermedia, aunque, como ya he comentado se puede hacer directamente. Para ello utilizo la función condicional IIF().
  • Consulta 01ImportesEnSuColumna: 
  • SELECT Datos.PRODUCTO, Datos.CATEGORIA, IIf(trim="T1",importe,0) AS PT, IIf(trim="T2",importe,0) AS ST, IIf(trim="T3",importe,0) AS TT, IIf(trim="T4",importe,0) AS CT, importe AS TA FROM Datos;
  • Acumulo o sumo esas columnas con la consulta 02CategoriaTrimestre agrupadas por "Categoria"
  • SELECT CATEGORIA, sum(PT) AS T1, sum(ST) AS T2, sum(TT) AS T3, sum(CT) AS T4, sum(TA) AS Total FROM 01ImportesEnSuColumna GROUP BY Categoria;
  • Como necesito un total de todas las categorías preparo una consulta que me de ese total, 03TotalTrimestres. En esta consulta doy un valor constante a uno de los campos (con "Total" AS CATEGORIA) y sumo los distintos importes de los distintos trimestres.
  • SELECT "Total" AS CATEGORIA, sum( [01ImportesEnSuColumna].PT) AS T1, sum([01ImportesEnSuColumna].ST) AS T2, sum( [01ImportesEnSuColumna].TT) AS T3, sum([01ImportesEnSuColumna].CT) AS T4, sum( [01ImportesEnSuColumna].TA) AS Total FROM 01ImportesEnSuColumna;
  • Uno ambos informes con la consulta de unión "04 InformeFinalPorTrimestre"
  • SELECT * FROM 02CategoriaTrimestre UNION select * from  03TotalTrimestres;


En este caso el informe es sencillo, se obtiene a partir de una sola tabla y, aunque complica mucho las instrucciones sql, se puede obtener fácilmente con una sola consulta. Casi cualquier informe se puede obtener con una sola consulta pero su complejidad aumenta exponencialmente al aumentar el número de componentes que intervienen en el tema. Es mejor dividirlo en pequeños módulos.

Consulta que nos da directamente el informe:


SELECT  Datos.CATEGORIA, sum(iif(trim="T1", importe,0) ) AS PT, sum(iif(trim="T2", importe,0) )AS ST,sum( iif(trim="T3", importe,0) )AS TT, sum(iif(trim="T4", importe,0) ) AS CT,sum( importe ) AS TA

FROM Datos group by Categoria

UNION SELECT  "Total" as CATEGORIA, sum(iif(trim="T1", importe,0) ) AS PT, sum(iif(trim="T2", importe,0) )AS ST,sum( iif(trim="T3", importe,0) )AS TT, sum(iif(trim="T4", importe,0) ) AS CT,sum( importe ) AS TA

FROM Datos;

Segundo informe, Tanto por ciento de las ventas por trimestre y año.
  • Este informe presenta el importe acumulado por trimestre y el tanto por ciento que supone ese acumulado sobre las ventas anuales. Para obtenerlo hay que obtener el acumulado por trimestre, consulta 11TotalPorTrimestre (SELECT Datos.TRIM, Sum(Datos.IMPORTE) AS TTrim FROM Datos GROUP BY Datos.TRIM;). Como necesito conocer el acumulado de los importes total preparo una consulta que me da ese acumulado (12TotalAñoInnecesario). 
  • Como ya dispongo de una consulta que me da ese total, esa consulta no es necesaria, con utilizar la consulta (03TotalTrimestres) que ya me da el total vale, no necesito otra consulta adicional.
  • Aquí tenemos un valor, el total, que no se añade como un registro mas después de los anteriores, es un valor que aparece como un campo mas en cada registro. No es una operación tipo JOIN, es una multiplicación matricial.
  • Esta multiplicación se hace abriendo dos tablas o consultas simultáneamente, como en la consulta "13TotalTrimestreyAño" 
  • SELECT Trim, TTrim, format(TTrim/Total,"0.00%") as PorCent FROM 11TotalPorTrimestre, 03TotalTrimestres; 
  • UNION select "Total" as Trim, Total,"" as PorCent from 03TotalTrimestres;








viernes, 5 de mayo de 2017

Encontrar el radio y el centro de un circulo con Excel.


Estoy intentando restaurar una vieja criba. En su momento fue una criba circular pero, con el paso del se fue deformando hasta el punto de que uno de los lados actualmente está prácticamente plano. Actualmente solo la mitad de la criba tiene forma circular. La cuestión que surge es, además de hacer una medida aproximada ¿Puedo saber el radio de la criba con lo que me queda de la criba? 


  • Lo puedo hacer mediante el siguiente método gráfico. 
  • Sobre el segmento que todavía mantiene forma circular colocamos tres puntos, mas o menos al azar.  A,B y D
  • Medimos las distancias AB (lado A), BD (lado B) y AD (lado D), en donde el lado D es la base del triangulo.
  • A escala, sobre papel, llevamos la distancia AD en el eje X.
  • Con un compás, a escala, desde el punto A llevamos la distancia AB y desde D llevamos la distancia BD. La intersección de ambos círculos nos da el vértice superior del triangulo.
  • Trazamos la perpendicular en el punto medio de los lados A y B. Desde los extremos de cada lado dibujamos un circulo con radio superior a la mitad del lado. La recta que une las intersecciones de los círculos nos da la perpendicular en el punto medio.
  • La intersección de las dos perpendiculares nos da el centro del circulo del que estamos buscando el centro. 
  • El radio, R, es la distancia, a escala, entre el centro y cualquiera de los puntos A,B o D.




Todo esto tiene su reflejo matemático. En principio hay que conocer las pendientes de los lados A y B sobre el lado D, al que colocamos en el eje X.
Para conocer las pendientes tenemos que conocer tanto la altura del triangulo como los lados C1 y C2. En otras ocasiones similares he utilizado el teorema del coseno para calcular tanto el ángulo como un lado desconocido. Esta vez lo vamos a hacer por Pitágoras.


  • Las pendientes de los lados son, por tanto, H/C1 y -H/C2.
  • Dos líneas son perpendiculares si sus pendientes son inversas y cambiadas de signo. 
  • Por tanto las pendientes de sus perpendiculares son -C1/H y C2/H.
  • Conocemos ya las pendientes, solo nos queda conocer un punto por el que pasa la recta, el punto medio de cada lado. 
  • Los puntos medios son C1/2, H/2 y C2/2,H2/2
  • La intersección de ambas líneas nos da el centro del círculo.
  • Una recta, la ecuación de una recta, es y=m*x +c, donde m es la pendiente y c en una constante propia de la recta. De cada perpendicular conocemos la pendiente y un punto por el que pasa. Sustituimos valores, despejamos y calculamos la constante.
  • Conocidas las ecuaciones de las perpendiculares igualamos las y , en el centro, punto de intersección de ambas líneas, tanto el valor de x como el de y son iguales. Igualamos las "y" y despejamos las "x". 
  • Calculamos, conocida la "x", la "y"
En excel utilizo o calculo esos términos  con mediante variables con nombre:
  • Altura=RAIZ(LadoA^2-LadoC1^2)
  • CLin1=YMitadA-PPLadoA*XMitadA. Constante línea A
  • Clin2=YMitadA-PPLadoB*XMitadB
  • LadoA=Datos!$A$3
  • LadoB=Datos!$B$3
  • LadoC1=(LadoA^2+LadoD^2-LadoB^2)/(2*LadoD)
  • LadoC2=LadoD-LadoC1
  • LadoD=Datos!$C$3
  • PLadoA=Altura/LadoC1. Pendiente del lado A.
  • PLadoB=-Altura/LadoC2. Pendiente lado B.
  • PPLadoA=-LadoC1/Altura
  • PPLadoB=LadoC2/Altura
  • Radio=RAIZ(XCentro^2+YCentro^2)
  • XCentro=(CLin1-CLin2)/(PPLadoB-PPLadoA)
  • XMitadA=LadoC1/2
  • XMitadB=LadoC1+LadoC2/2
  • YCentro=PPLadoA*XCentro+CLin1
  • YMitadA=Altura/2






lunes, 10 de abril de 2017

Emulación botonera tres posiciones con VBasic para excel y grabadora de macros



Voy a emular una botonera de tres botones y tres posiciones con VBasic para excel usando la grabadora de macros. La grabadora de macros, cuando la activamos, recoge lo estemos haciendo y nos da el código VBasic que nos permite repetir o automatizar vía programa la tarea realizada.
La botonera emulada es una botonera de tres botones con un led asociado a cada botón. Al pulsar uno de los botones pasa una  posición hundida, su led se enciende y los otros dos botones saltan a una posición resaltada y sus luces se apagan. Supongamos que es la botonera de un aparato para encender o apagar algo remotamente. Las tres posiciones son apagado, encendido y programación por tiempo. Como esto es una emulación de la botonera la parte de programación por tiempo no está incluida.
  • Los botones son formas (shapes) rectangulares o circulares con un formato tridimensional. Aparentan volumen.
  • Antes de empezar hay que imaginar un primer diseño de lo que será la botonera. 
  • En este caso uno de los rectángulos hace de fondo, con formato plano, y los otros tres rectángulos presentan un formato 3D. Uno de los botones parece pulsado y los otros dos sobresalen.
  • El led asociado al  botón pulsado luce y no lucen el resto de los led.
  • La emulación de un led encendido la hago con un aumento de color.
Grabadora de macros: Mis libros sobre VBasic están un poco desactualizados. Al cambiar de máquina cambié de versión de office, y por tanto de excel. Algunas cosas que se pueden hacer hoy hace unos años no se podían hacer.
  • Manualmente preparamos, sin profundizar, el tipo y formato de los botones.
  • Una vez encontrado el diseño, activamos la grabadora de macros. En mi actual excel, Vista->Macros->Grabar Macro.
  • Insertamos un rectángulo.
  • Detenemos la grabadora.
  • Vemos el código generado. Nos genera un código similar a:

 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 301.5, 46.5, 68.25, 36.75).Select

  • Jugando un poco con los valores numéricos vemos que esos valores son los valores izquierda y superior (arriba) de la esquina superior izquierda, y ancho y alto del rectángulo. 
  • Activamos grabadora. 
  • Damos formato al rectángulo. Datos el formato deseado del botón resaltado.
  • Damos el formato de botón pulsado y paramos la grabación.
  • Vemos el código generado.

Sub Macro2()

'
' Macro2 Macro
'

'
    With Selection.ShapeRange.ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With

    With Selection.ShapeRange.ThreeD
        .BevelTopType = msoBevelRelaxedInset
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
End Sub


  • Repito el proceso para los led. Inicio grabadora y creo un circulo. Le doy formato y color, le cambio de color a un tono mas brillante y detengo la grabadora.
  • Nos da un código parecido a:

Sub Macro3()

'

' Macro3 Macro
'

'
    ActiveSheet.Shapes.AddShape(msoShapeOval, 361.5, 60, 21, 19.5).Select
    With Selection.ShapeRange.ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
End Sub


  • Nuestro circulo (elipse) esta inscrito en un rectángulo. En la instrucción que añade el circulo los valores numéricos son, lo mismo que en el caso anterior, izquierda, superior, ancho y alto. Si queremos un circulo alto y ancho deben ser iguales.
  • El color lo da la función RGB (rojo, verde, azul). Es una combinación de tres los colores básicos, los valores deben estar entre 0 y 255. Cuanto mas alto es un valor mas componente de ese color hay. RGB(125,0,0) da un rojo mas oscuro que RGB(255,0,0)
  • ¿Como conocer el RGB de un color?. Con Paint. Abrimos Paint y entramos en la opción "editar colores". Seleccionamos un color básico o un color de la gama completa de colores. Abajo, a la derecha, encontramos el RGB del color seleccionado.
  • ¿Que otras propiedades puede tener el objeto shape? o cualquier otro objeto.
  • Entramos en los módulos Ver->Examinador de objetos. Salen todos, objetos y colecciones. Buscamos Shape , en singular y shapes en plural. 
  • La pregunta es ¿Como hago referencia a una forma determinada en una hoja con varias formas?
  • Se puede hacer referencia a un una forma determinada por su orden de creación (sahapes(1)) o por su nombre. Se puede asignar un nombre con la propiedad .name.
Tareas repetitivas:
Con la información obtenida con la grabadora se pueden crear todos los botones vía programación. La macro Botonera borra todos los rectángulos que haya en la hoja, los crea y les da formato.


Sub Botonera()

Dim I

NombresyColores
With Sheets("Inicio")
.Select
'******************************Borra shapes****
.Shapes.SelectAll
Selection.Delete
'***************Añade el fondo*******
.Shapes.AddShape(msoShapeRectangle, 25, 25, 115, 90).Select
'*********************************************
 For I = 1 To 3
 'izda,superior,ancho,alto
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 10 + 25 * I, 80, 20).Select
  
  With Selection

  .Name = NBoton(I) 'Da nombre al botón

.Text = NBoton(I) 'Situa texto del botón
.OnAction = Progs(I) 'Asigna la macro asociada al botón
' Centra tanto verticalmente como horizontalmente el texto del botón. Obtenido con la grabadora de macros
.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
.ShapeRange.TextFrame2.HorizontalAnchor = msoAnchorCenter
   End With

    Next
    EN = False
    PT = False
    AP = True
    Leds
  Redibuja
  .Range("a1").Select
End With

End Sub

La macro para incluir los led (macro leds) es similar. Está incluida en el libro excel. 

Cada botón tiene asociada una macro que se lanza al pinchar sobre el. Cada botón tiene asociada, además, una variable booleana, EN de encendido, AP de apagado y PT de programación por tiempo, que indica su situación del botón. Cada botón, ademas, tiene un nombre con el que podemos referenciarlo.
Las macros asociadas a cada botón, en este caso, modifican las variables booleanas asociadas a los tres botones y lanzan la macro "Redibuja", en donde utilizamos las instucciones que hemos obtenido al utilizar la grabadora de macros. El mecanismo general es pasar cada botón a la posición resaltada para después, si es un botón pulsado pasarlo al formato asociado a pulsado. Lo mismo hace para el led encendido. Primero lo apaga y, si debe estar encendido, lo enciende.

Macro Auto_open(). Esta macro está asociada al evento "abrir el libro". Al abrir el libro se ejecuta directamente. En este caso solamente doy valor a unas cuantas variables publicas y redibujo la botonera. 

En vez de tres luces se puede utilizar una sola, que cambiaría de color en función de la posición de los botones. Es tan fácil como utilizar 3 leds.









martes, 4 de abril de 2017

Luces y sombras en excel. Dibujos 3D en excel.



Pequeño trabajo dedicado mas que nada a la presentación. ¿En algún momento hemos necesitado incluir algún efecto 3D en una hoja excel? 

Resaltes y hundimientos:
  • Resalto emulando un botón. Funciona con todos los colores pero sobre todo con colores oscuros. Como necesitamos tres tonos de color, no pueden tener el tono mas oscuro.
  • Funciona particularmente bien con el gris. Con otros colores, los mas claros sobre todo, el efecto 3D se diluye.
  • Supongamos que la luz viene de nuestra izquierda según se mira a la pantalla. La luz que incide sobre un objeto que sobresalga ilumina el borde superior y el borde izquierdo. El borde inferior y el borde derecho permanecen en sombra. Si el objeto esta hundido es al revés, la luz ilumina los bordes inferior y derecho y deja en la sombra los otros dos bordes.
  • Si la luz viene de nuestra derecha los bordes iluminados/en sombra son borde derecho y superior y borde izquierdo e inferior.
  • Por alguna razón que no se explicar parece que funciona mejor si queremos emular una luz por la izquierda.
  • Si damos un tono mas claro a los bordes iluminados y un tono mas oscuro a los bordes en sombra conseguimos un efecto 3D, un botón realzado o un botón hundido.
  • Seleccionamos un rango de celdas, le damos un color gris medio.
  • Seleccionamos, dentro de ese rango, una celda. 
  • Seleccionamos formato de la celda.
  • Seleccionamos Borde.
  • Seleccionamos un gris mas claro que el general de las celdas. 
  • Asignamos ese color al par de bordes correspondientes al efecto deseado.
  • Hacemos lo mismo, con un tono gris mas oscuro, con los otros dos bordes.
  • Con un borde ancho el efecto 3D se diluye un poco.
Imágenes con sombra. Imagen flotante en el espacio:
  • Basta con colocar debajo de ella una imagen idéntica, en cuanto a la forma, pero con un relleno mas oscuro, desplazada ligeramente con respecto a la imagen que queremos que aparezca flotando. Un poco mas a la derecha y un poco mas a abajo, luz de izquierdas. Esto emula una sombra, lo que hace que nuestra imagen parezca que flota en el espacio.
  • Excel tiene una herramienta que permite dar un cierto volumen e  incluir sombras en las imágenes o formas insertadas. Dependiendo de la versión de excel será mas o menos completa. En mi caso tengo instalado office 2013. Con el botón derecho del ratón sobre una imagen se accede al formato de la imagen y en formato se puede jugar con el volumen y la sombra de la imagen.




Matrices de varias dimensiones en VBasic.

Matrices o arrays. Tengo una lista de actuaciones de una multinacional en las 50 provincias españolas. De esa lista debo sacar un resumen de actuaciones por provincia y mes, así como la duración media de las actuaciones con un total anual y un total nacional. Voy a utilizar una macro VBasic con una matriz de mas de una dimensión.
  • Tenemos 50 provincias mas un total nacional.
  • El informe es de los 12 meses del año mas un total anual.
  • Debe incluir tanto el número de actuaciones como la duración media.
  • Por tanto nuestra matriz debe ser de 51*13*2. (50+1,12+1, Act. y duraciones)
  • En la lista hay actuaciones terminadas y actuaciones sin terminar (franqueadas o no franqueadas). 
  • El informe es de actuaciones franqueadas por provincia y mes, independientemente de cuando se inició la actuación.
  • La macro lee de inicio a fin, de una en una, todas las líneas con actuaciones.
  •  Acumula tanto las actuaciones como las duraciones por provincia y mes.
  • Solo si la actuación esta franqueada la tiene en cuenta. 
  • Existe otro filtro, debe estar franqueada en un año determinado.
  • A siguiente código le falta situar el nombre de los meses en la primera línea del informe. Un mes para dos columnas, centrado entre dos celdas. Lo he dejado así para que aquellos que estén interesados lo hagan por su cuenta. Como ejercicio de programación.
  • Por último incluimos un botón en la hoja inicio para lanzar el proceso. Después de incluir el botón, le asignamos la macro con el botón derecho del ratón.  



Código:
***************************Inicio código*******

Sub ProcesoActuaciones()

Dim D, Pr, Nl, Cp, Dur, I, FI, FF, Act(51, 13, 2), AAAA, MM, AProc, J, Meses, Prvs
Meses = Array("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre", "T.Año")
 'Act(51,13,2) matriz en donde acumulamos los datos
'Meses= Array o matriz con los meses del año. 


Set D = Sheets("Actuaciones")
Set Pr = Sheets("Prv")
Prvs = Pr.Range("b2:b52").Value
AProc = Sheets("Inicio").Range("a2").Value 'Año que se procesa. Lo lógico es colocarlo externamente a este código. Lo sitúo en la hoja Inicio celda A2

With D
Nl = .UsedRange.Rows.Count 'Cuenta el número de lineas usadas

For I = 2 To Nl 'La línea 1 contiene las cabeceras
Cp = .Range("a" & I).Value 'código de provincia
FI = .Range("b" & I).Value 'fecha de inicio
FF = .Cells(I, 3).Value 'fecha fin. Tambien podemos hacer referencia a una celda con cells(fila,columna)

If FF > FI Then ' Si la fecha finalización es mayor que la de inicio
AAAA = Year(FF) 'Año fin
MM = Month(FF) 'mes fin
    If AAAA = AProc Then 'Año de proceso
'************Acumulados provinciales****************
    Act(Cp, MM, 1) = Act(Cp, MM, 1) + 1 'Acumula actuaciones.
    Act(Cp, MM, 2) = Act(Cp, MM, 2) + FF - FI 'Acumula duraciones
    Act(Cp, 13, 1) = Act(Cp, 13, 1) + 1 'Acum. act. Año
    Act(Cp, 13, 2) = Act(Cp, 13, 2) + FF - FI 'Acum. durac. año
'************Acumulados nacionales****************
Cp = 51
    Act(Cp, MM, 1) = Act(Cp, MM, 1) + 1
    Act(Cp, MM, 2) = Act(Cp, MM, 2) + FF - FI
    Act(Cp, 13, 1) = Act(Cp, 13, 1) + 1
    Act(Cp, 13, 2) = Act(Cp, 13, 2) + FF - FI

    End If

End If
Next
End With

With Sheets("resumen")
.UsedRange.Rows.Delete 'Elimina las lineas utilizadas
For I = 1 To 51 'Para cada una de las provincias y el total nacional
'.Range("a" & I + 1).Value = I
For J = 1 To 13 'Para cada mes
.Cells(I + 2, J * 2).Value = Act(I, J, 1)
If Act(I, J, 1) > 0 Then .Cells(I + 2, J * 2 + 1).Value = Act(I, J, 2) / Act(I, J, 1) 'Las duraciones medias son el total de duraciones/nºact. en donde N.Act debe ser mayor que cero, si no daría error.
Next
Next

For J = 1 To 13 ' Colocamos los literales 
.Cells(2, J * 2).Value = "N.Act."
.Cells(2, J * 2 + 1).Value = "D.Med."
.Columns(J * 2 + 1).Cells.NumberFormat = "[h]:mm"'Damos formato a la columna con d.m.
Next
.Range("a3:a53").Value = Sheets("prv").Range("b2:b52").Value 'Colocamos los nombres de las provincias
.Range("a1").Value = "Año:" & AProc 'informe del año 
.UsedRange.Columns.AutoFit
End With

With Sheets("aux")
.Cells.Clear
.Range("b1:n1").Value = Meses
.Range("a3:a53").Value = Prvs
End With
End Sub

*****************Fin código*******************
A este código le falta situar el nombre de los meses en la primera línea del informe. Lo he dejado así para que aquellos que estén interesados lo hagan por su cuenta. Como ejercicio de programación.

viernes, 24 de marzo de 2017

Lectura y escritura de ficheros de texto con VB para Excel. De KML a GPX V


Sigo con el ejemplo de la entrada anterior, convertir un fichero KML en un fichero GPX. Para convertir un tipo de fichero en otro tipo de fichero necesito conocer la estructura de los datos en ambos tipos de ficheros. Mas o menos ambas están explicadas en la entrada anterior.

Esta vez lo voy a hacer por programación, no mediante el camino, un tanto barroco, de preparar el fichero de texto para colocar los distintos campos de datos a mi conveniencia y mediante formulas excel, separar, concatenar, para volver a editar un fichero de texto y ¡por fin! obtener el resultado final.

Antes de empezar la a trabajar es conveniente conocer algunas particularidades del código ASCII en ficheros de texto, que es el código que se utiliza para representar los distintos caracteres. El código ASCII se puede dividir en dos partes, los llamados caracteres de control y los caracteres imprimibles. De los caracteres de control, desde mi punto de vista, solo tienen interés en un fichero de texto, la tabulación (ASCII 9), el salto de línea (LF, ASCII 10) y el retorno de carro (CR, ASCII 13). El resto de los caracteres de control , algunos, probablemente se sigan utilizando en los teclados y otros  ya no tengan ninguna utilidad, se utilizaban para máquinas hoy en día en prácticamente desuso, como los teletipos.
Dependiendo de donde venga un fichero de texto puede que el fin de línea lo haga con un CR+LF o solamente con un LF. El doble fin de línea, desde mi punto de vista, viene de las ya olvidadas máquinas de escibir, anteriores a cualquier ordenador y a otro tipo de máquinas como los telex o teletipos. Para los que conocimos las máquinas de escribir tiene sentido, era lo que se hacía para pasar a la siguiente línea.

Algunas funciones de VBasic para el manejo de textos:

  • Dos textos se concatenan con un &. Es para textos el equivalente al + para los números.
  • Asc(Carac). Devuelve el número ASCII del carácter.
  • Right(Cadena,n). Devuelve los últimos n caracteres de la derecha de una cadena alfanumérica.
  • Left(Cadena,n). Devuelve los primeros n caracteres de la izquierda de una cadena alfanumérica.
  • Lin = Mid(Lin, Pos1 + 6,n). Devuelve, a partir de el segundo parámetro (Pos1+6), n caracteres. Este tercer parámetro es opcional.
  • InStr(LCase(Lin), "<when>"). Devuelve la posición en la que se encuentra una cadena dentro de otra. 
  • LCase(Cad). Devuelve la cadena en minúsculas.
  • UCase(cad). Devuelve la cadena en mayúsculas.
  • Len(Cad). Longitud o número de caracteres de una cadena alfanumérica.
  • Split(Cad,Car). Divide y pasa la cadena alfanumérica a una matriz. El carácter "car" es el separador.
  • Chr(n). Devuelve el carácter correspondiente al número n (en decimal).
  • Replace("ABCD", "D", "X"). Cambia un conjunto de caracteres por otros. En este caso cambia D por X.
  • Format(9, "0.00"). Da formato a un texto, en este caso presenta 9 como 9,00. Da muchas posibilidades.
  • Algunas de las funciones anteriores tienen otros parámetros adicionales.
En principio la conversión es relativamente sencilla, incluso es mucho mas sencilla que hacerla sin programación. Sin programación, lo reconozco es una cosa muy compleja.

Proceso de lectura:
  • Cierro, el fichero #n con close #n. En este caso n=1.
  • Leo, en la primera hoja del libro excel, el nombre y el directorio de trabajo.
  • Abro el fichero origen con Open DirT & Nom For Input As #1
  • Leo, secuencialmente, hasta el final y carácter a carácter, el fichero de texto origen de los datos.
  • En este caso no considero el carácter de ascii 13. No lo trato.
  • Concateno el carácter leído con los caracteres leídos con anterioridad. 
  • Busco el/los delimitadores, o etiquetas que me marcan los datos. Para la fecha y hora de un punto busco las etiquetas <when> y </when> con  Pos1 = InStr(LCase(Lin), "<when>")  y Pos2 = InStr(LCase(Lin), "</when>"), trabajando en minúsculas. Extraigo los datos con Lin = Left(Lin, Pos2 - 1) y Lin = Mid(Lin, Pos1 + 6). 
  • Separo los datos. Una vez encontrados, mantengo fecha y hora pero separo las coordenadas y la altura con Coor = Split(Lin, ",").
  • Concateno los datos válidos con las etiquetas correspondientes a los ficheros GPX.
  • Un punto está definido por unas coordenadas, su altura y la fecha y hora en que fue tomado, aunque en este fichero kml aparece primero la fecha y hora. Al encontrar una linea de datos pongo a cero (Lin=""). Al encontrar todos los datos de un punto los escribo en el fichero de salida y en la hoja excel Aux e incremento línea para la siguiente vez que escriba en la hoja excel. Hay otras maneras, quizás mas correctas, de hacerlo. Cosas que he heredado de mi mismo. Empiezas a hacerlo de una manera y continuas haciendolo así, sin plantearmelo. 
  • Al encontrar un carácter 10 (LF) borro Lin (Lin=""). En otros casos, lo lo mejor, sería conveniente convertirlo en un cáracter nulo.


    Libro excel:
    • Tiene dos hojas, en la primera ("Config"), sitúo el directorio de trabajo y el nombre del fichero de texto a leer.
    • El fichero de salida hereda tanto directorio de trabajo como nombre del fichero de entrada.
    • Con Alt+F11 se puede entrar a los módulos VBasic. Localizo la macro LeeTexto2 y la ejecuto con F5.
    • La macro LeeTexto2 convierte el fichero KML a fichero GPX.
    Escritura en fichero de texto de salida:


    • Cierro, el fichero #n con close #n.
    • Abro el fichero de salida. Nombre, incluido directorio, y  tipo de E/S. En este caso Open DirT & NomRut For Output As #2. A partir de este momento podemos escribir en el fichero de salida con Print #2, Texto
    • Escribo la cabecera propia de los ficheros GPX.
    • Incorporo los datos encontrados durante el proceso de lectura del fichero origen (#1)
    • Escribo la cola propia de los ficheros GPX.
    • Cierro fichero.
    Código de LeeTexto2:


    Sub LeeTexto2()
    Dim Carac, Lin, Pos1, Pos2, DirT, Nom, N, Longitud, Coor, LinT, NomRut, H
    NomRut = "prueba"
    Nom = Sheets(1).Range("b2")
    DirT = Sheets("Config").Range("a2")
    Set H = Sheets("aux")
    H.UsedRange.Clear
    Close #1
    Close #2
    N = 1
    NomRut = Left(Nom, Len(Nom) - 4) & "xx.GPX"

    '******************** Fichero gpx de salida ********************************
    Open DirT & NomRut For Output As #2
    '*************************************************Cabecera fichero GPX ***************
    Print #2, "<?xml version='1.0' encoding='UTF-8' standalone='no' ?>"
    Print #2, "<gpx xmlns='http://www.topografix.com/GPX/1/1' creator='MapSource 6.12.4' version='1.1' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xsi:schemaLocation='http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd'>"

    Print #2, "<metadata>"
    Print #2, "<link href='http://www.garmin.com'>"
    Print #2, "<text>Convertido por programa</text>"
    Print #2, " </link>"

    Print #2, "</metadata>"

    Print #2, "<trk>"

    Print #2, "<name>" & NomRut & "</name>"
    Print #2, "<extensions>"
    Print #2, "<gpxx:TrackExtension xmlns:gpxx='http://www.garmin.com/xmlschemas/GpxExtensions/v3' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xsi:schemaLocation='http://www.garmin.com/xmlschemas/GpxExtensions/v3 http://www.garmin.com/xmlschemas/GpxExtensions/v3/GpxExtensionsv3.xsd'>"
    Print #2, "<gpxx:DisplayColor>Red</gpxx:DisplayColor>"
    Print #2, "</gpxx:TrackExtension>"
    Print #2, "</extensions>"
    Print #2, "<trkseg>"
    '*************************************************Cabecera fichero GPX ***************

    Open DirT & Nom For Input As #1

    Do While Not EOF(1)
    Carac = Input(1, #1)
    Lin = Lin & Carac

    Pos1 = InStr(LCase(Lin), "<when>")
    Pos2 = InStr(LCase(Lin), "</when>")

    If Pos1 > 0 And Pos2 > 0 Then
    Lin = Left(Lin, Pos2 - 1)
    Lin = Mid(Lin, Pos1 + 6)
    LinT = Lin
    Lin = ""
    End If

    Pos1 = InStr(LCase(Lin), "<coordinates>")
    Pos2 = InStr(LCase(Lin), "</coordinates>")
    Longitud = Len("<coordinates>")
    If Pos1 > 0 And Pos2 > 0 Then
    Lin = Left(Lin, Pos2 - 1)
    Lin = Mid(Lin, Pos1 + Longitud)

    Coor = Split(Lin, ",")
    'Sheets("Aux").Range("b" & N).Value = Coor(0)
    'Sheets("Aux").Range("c" & N).Value = Coor(1)
    'Sheets("Aux").Range("d" & N).Value = Coor(2)
    'Sheets("Aux").Range("b" & N & ":d" & N) = Split(Lin, ",")
    Lin = ""

    Print #2, "<trkpt lat='" & Coor(1) & "' lon='" & Coor(0) & "'>"
    Print #2, "<ele>" & Coor(2) & "</ele>"
    Print #2, "<time>" & LinT & "</time>"
    Print #2, "</trkpt>"
    H.Range("a" & N).Value = "<trkpt lat='" & Coor(1) & "' lon='" & Coor(0) & "'>" & _
    "<ele>" & Coor(2) & "</ele>" & "<time>" & LinT & "</time>"



    N = N + 1
    End If
    If Asc(Carac) = 10 Then
    'H.Range("a" & N).Value = Lin
    Lin = ""
    'N = N + 1
    End If


    Loop
    Close #1
    '*************************************************Cierre ruta fichero GPX ***************
    Print #2, "</trkseg>"
    Print #2, "</trk>"
    Print #2, "</gpx>"
    '*************************************************Cierre fichero salida***************
    Close #2
    End Sub