Comenzamos este último mes del año con las pilas cargadas. En esta entrada os dejo una utilidad también bastante peculiar (vamos a lo que os intento tener acostumbrados) que permite realizar las siguientes tareas:

El programa funciona a modo de autómata y consiste en seleccionar un directorio origen donde se encuentran imágenes de cualquier tamaño y formato, para una vez procesadas, dejarlas en un directorio destino con un nombre que corresponde con las reglas de un fichero en formato Excel.

Admite el proceso por lotes, es personalizable en cuanto a las imágenes y marcas de agua (watermark)  que deseemos disponer. Una vez seleccionado el programa irá recorriendo cada fila (en función de unos parámetros previamente establecidos) y asociando nombres en función de los datos de la hoja de cálculo.

En la salida de las imágenes, éstas, son tratadas aplicando una marca de agua (si deseamos) y generando 2 imágenes, una de ellas en miniatura y la otra con el nombre destino seleccionado en la hoja de cálculo.

El esencia este proyecto muestra como conectarse usando 2 APIs.

La primera de ellas permite comunicarse con cualquier versión de Excel. La segunda permite trabajar con imágenes usando la librería freeimage360.dll y es de uso público. Está constituida por un conjunto de funciones de manipulación de formatos gráficos. La DLL o biblioteca de enlace dinámico no requiere registro.

Para usar el programa es necesario especificar un directorio origen (donde se encuentran las imágenes fuente) y un directorio destino (donde queremos dejarlas). En este directorio destino se crearan las imágenes reducidas y otras con marca de agua si así se establece.

El fichero Excel permite establecer una correlación entre el nombre de la imagen origen y el nombre de la imagen destino. Las coordenadas que pueden ser alteradas muestran la posición donde se empieza a cotejar los datos, es decir, donde se encuentra el primer nombre de la imagen y como deseamos llamarla en el proceso de renombrado. También dispone de un sistema de estadísticas, mostrando que imágenes a podido procesar y cuales no. Genera un fichero de texto para poder almacenar los errores o no asociaciones. Por otro lado, genera un aviso sonoro una vez terminado el proceso.

FASES

Primero seleccionamos con los iconos fuente y destino las carpetas.

Las opciones fila y columna las dejamos por defecto, puesto que encajan con el fichero Excel de ejemplo incorporado.

La imagen superior muestra la imagen inicial a tratar.

Mediante la marca de agua o watermark podemos personalizar la imagen salida. Como se muestra en la ilustración superior.

La imagen inferior muestra la estructura del fichero en formato excel. Podríamos tener mas filas, sólo os dejo 2 a modo de ejemplo, una funciona, la otra genera un error para que veáis como funciona:

Mi_imagen_origen corresponde con el nombre real de la imagen que se encuentra en la carpeta origen, la coordenada A6 contiene el nombre por el que será renombrado después del tratamiento 1 (la extensión depende de nuestra configuración). Se ha personalizado un salto de filas para procesar la siguiente y así sucesivamente.

El proceso de salida muestra las estadísticas cuando el programa concluye.

Fichero de texto generado.

La imagen inferior muestra la conclusión del proceso.

La imagen superior también muestra el tiempo que ha transcurrido en el procesamiento, y el progreso. Podremos ver las imágenes generadas directamente pulsando el la carpeta ver.

Puede llegar a procesar unas 1000 imágenes (dependerá del tamaño del fichero origen) en 10 minutos aproximadamente. Consejo, deja al ordenador respirar mientras trabaja :-), todavía no he optimizado el tema de los threads o hilos.

En fin, no se si os será de mucha utilidad, pero ahí os lo dejo. Necesito mejorar algunas cosas que todavía están pendientes (cuando disponga de más tiempo).

Para descargar el programa pulsar sobre la imagen de descarga. He probado el programa en sistemas operativo Windows como XP, 7, 8 y 10.

En principio, Libre de virus, analizado con AVG, Avast, Malwarebytes.
Algunas soluciones antivirus pueden dar falsas alarmas.
Por otro lado, no me hago responsable del uso del software y de sus consecuencias derivadas.

Estas condiciones se aceptan cuando descargo el programa.

Otras observaciones

El programa no requiere instalación. Es un fichero en formato comprimido Winrar, donde se encuentra un ejecutable EXCEL-A-IMAGEN.exe , carpetas de ejemplo origen y destino. Es decir, donde tenemos las imágenes (incluyo una de ejemplo) y donde queremos que las deje. La carpeta números contiene imágenes, PSDs y JPG personalizables por nosotros. Incluye la librería FreeImage.dll y el PDF para mostrarnos todas las funciones que dispone para trabajar con ella a modo didáctico.

Requiere que el fichero Excel, se encuentra en formato xls.

Adjuntos –

Ejemplo código botón procesar:

'El botón procesar es el mas complejo, muestro parte del código.

Dim nodo As Node

Ajustecmd.Visible = False

Unload frmOptions

frmOptions.Hide
Set nodo = frmOptions.miarbol.Nodes.Add()
nodo.Text = "-> Imagenes asociadas"
Set nodo = frmOptions.miarbol.Nodes.Add()
nodo.Text = "-> No asociadas"

'Empecemos con el procedimiento de renombrado
On Error Resume Next
  Dim imagen_origen, imagen_destino, bOK As Long

procesar.Visible = True
procesar.Caption = "Procesando ..."
visor.Visible = True

Dim vfuente, vdestino, varchivo, Vco, Vcd As String
Dim vfo, vfd, vdesplazamiento As Integer

Vco = CStr(CO.Text)
Vcd = CStr(CD.Text)
vfo = CInt(FO.Text)
vfd = CInt(FD.Text)
vdesplazamiento = CInt(desplazamiento.Text)

vfuente = CStr(fuente.Caption)
vagua = CStr(lagua.Caption)
vagua2 = CStr(lagua.Caption)

 Set fso = New Scripting.FileSystemObject
   bytescarpeta = fso.GetFolder(vfuente).Size
 Set fso = Nothing

If bytescarpeta <= 50 Then
   
    MsgBox "No existen archivos en la carpeta fuente especificada, incluya los JPGs", vbCritical
    
 End If
 
 
vdestino = CStr(destino.Caption)
varchivo = CStr(Ficheroexcel.Caption)
If vfuente = "ruta de imágenes fuente" Or vdestino = "ruta de imágenes fuente destino" Or varchivo = "Archivo de excel no seleccionado" Or Vco = "" Or Vcd = "" Then
    MsgBox "Es necesario especificar la fuente, el destino y el archivo XLS", vbCritical, "Error de archivos"
    procesar.Visible = False
    
Else
'On Error GoTo errores
' En caso de estar todo correcto
' Empezamos con la creación del objeto excel
Dim appExcel As Excel.Application
Dim Salida As String
Dim nodosecundario As Variant




Set appExcel = CreateObject("Excel.Application.9")
appExcel.Quit


Salida = "NO"
'varchivo = Replace(varchivo, "\", "\\")

appExcel.Workbooks.Open varchivo
i = 0
numerodeimagenesaprocesar = 0

Set fs = CreateObject("Scripting.filesystemobject")
Set a = fs.CreateTextFile("errores.txt", True)
Slider1.Visible = False
pmarcaagua.Checked = False

Do

rango_origen = Vco & CStr((CInt(vfo) + i))
rango_destino = Vcd & CStr((CInt(vfd) + i))
i = i + vdesplazamiento
numerodeimagenesaprocesar = numerodeimagenesaprocesar + 1

Loop While CStr(appExcel.Range(rango_origen).Value) <> "" And CStr(appExcel.Range(rango_origen).Value) <> ""

 

numerodeimagenes = 1
i = 0
visor.Visible = True
 contadortabla = 0
 Noprocesadas = 0
 
procesocancelado = "NO"
dospuntos.Visible = True
segundos.Visible = True
minutos.Visible = True
segundos.Caption = "0"
minutos.Caption = "0"

' Empecemos con el buque
Do
Form1.Command1.Visible = False
cancelar.Visible = True

ProgressBar1.Min = 1
ProgressBar1.Max = (CInt(ProgressBar1.Width) * numerodeimagenes) / numerodeimagenesaprocesar
ProgressBar1.Value = 1

DoEvents
    If CInt(ProgressBar1.Value) < 11055 Or numerodeimagenes > 1 Then
    ProgressBar1.Value = (CInt(ProgressBar1.Max) * numerodeimagenes) / numerodeimagenesaprocesar
    numerodeimagenes = numerodeimagenes + 1
   End If
   
   DoEvents
   
    
   contadortabla = contadortabla + 1
    'appExcel.Range(Vco + vfo).Select
    rango_origen = Vco & CStr((CInt(vfo) + i))
    rango_destino = Vcd & CStr((CInt(vfd) + i))
    If CStr(appExcel.Range(rango_origen).Value) <> "" Or CStr(appExcel.Range(rango_destino).Value) <> "" Then
   
    
    contenido_origen = "\" & CStr(appExcel.Range(rango_origen).Value & Extension)
    contenido_destino = "\" & CStr(appExcel.Range(rango_destino).Value & ".jpg")
    marcaagua = \\agua.jpg
 

    
    contenido_completo_origen = vfuente & contenido_origen
    contenido_completo_destino = vdestino & contenido_destino
    contenido_completo_origen = Replace(contenido_completo_origen, "\", "\\")
    contenido_completo_destino = Replace(contenido_completo_destino, "\", "\\")
    
    diragua = Replace(vagua, "\", "\\")
    diragua2 = Replace(vagua, "\", "\\") & "\\marca.png"
    marcaaguac = Replace(vagua, "\", "\\") & marcaagua
    
    'Preparamos las estadisticas
    Set nodo = frmOptions.miarbol.Nodes.Add(1, tvwChild)
    If CStr(appExcel.Range(rango_origen).Value) <> "" Then
         'Comprobamos si existe el chino
         
          If Dir(contenido_completo_origen) = "" Then
             
             Set nodo = frmOptions.miarbol.Nodes.Add(2, tvwChild)
                 nodo.ForeColor = 255
                    nodo.Tag = "No procesado"
                        Noprocesadas = Noprocesadas + 1
     nodo.Text = CStr(contadortabla) & " - C.O: " & rango_origen & " valor: " & CStr(appExcel.Range(rango_origen).Value & Extension) & " || C.D.: " & rango_destino & " : " & " valor: " & CStr(appExcel.Range(rango_destino).Value & ".jpg")
    nodo.Key = CInt(contadortabla) & " ID"
             a.WriteLine nodo.Text
             
             
             End If
             
          Set fso = Nothing
 
    nodo.ForeColor = 0
    nodo.Tag = "procesado"
    nodo.Text = CStr(contadortabla) & " - C.O: " & rango_origen & " valor: " & CStr(appExcel.Range(rango_origen).Value & Extension) & " || C.D.: " & rango_destino & " : " & " valor: " & CStr(appExcel.Range(rango_destino).Value & ".jpg")
    nodo.Key = CInt(contadortabla) & " ID"
    nodosecundario = nodo.Index
    
    
    Else
 

    Set nodo = frmOptions.miarbol.Nodes.Add(2, tvwChild)
    nodo.ForeColor = 255
    nodo.Tag = "No procesado"
    Noprocesadas = Noprocesadas + 1
    nodo.Text = CStr(contadortabla) & " - C.O: " & rango_origen & " valor: " & CStr(appExcel.Range(rango_origen).Value & Extension) & " || C.D.: " & rango_destino & " : " & " valor: " & CStr(appExcel.Range(rango_destino).Value & ".jpg")
    nodo.Key = CInt(contadortabla) & " ID"
        a.WriteLine nodo.Text
    End If
    

    'Proceso de copia de la imagen fuente al destino con formato, compresión y resolución determinados.
        
    'Cargamos la imagen origen
  
     If Extension = ".JPG" Then
     imagen_origen = FreeImage_Load(FIF_JPEG, contenido_completo_origen, 0)
     formatito = FIF_JPEG
     Else
     imagen_origen = FreeImage_Load(FIF_TIFF, contenido_completo_origen, 0)
     formatito = FIF_TIFF
     End If
     
     'MsgBox contenido_completo_origen
     
     If (FreeImage_Load(formatito, contenido_completo_origen, 0)) Then
      visor.Caption = "Leyendo imagen: " & contenido_origen
           
                DoEvents
           
 
           'imagen_destino = FreeImage_Save(FIF_JPEG, imagen_origen, contenido_completo_destino, 0)
                
         If CStr(appExcel.Range(rango_origen).Value) <> "" And CStr(appExcel.Range(rango_destino).Value) <> "" Then
          
                    cestadisticas.Visible = True
                    
       
 
    ' Nos encargamos de dar calidad a la imagen
                If Calidadmedia.Checked = True Then
                    calidadimagen = JPEG_QUALITYNORMAL
                End If
                If calidadAlta.Checked = True Then
                    calidadimagen = JPEG_QUALITYSUPERB
                End If
                If CalidadBaja.Checked = True Then
                    calidadimagen = JPEG_QUALITYAVERAGE
                End If
                 If Calidadmuybaja.Checked = True Then
                    calidadimagen = JPEG_QUALITYBAD
                End If
                
            'Nos encargamos de miniaturizar
            
            'x = FreeImage_GetDotsPerMeterX(imagen_origen)
             X = FreeImage_GetWidth(imagen_origen)
             Y = FreeImage_GetHeight(imagen_origen)
             
             If (csne2.Checked) Then
               
               DimensionX = dimensiongrande
               dimensionXpeque = dimensionpequena
               DimensionY = Y * dimensiongrande / X
               dimensionYpeque = Y * dimensionpequena / X
               
               
             
             End If
             If (csne1.Checked) Then
                'dimensionX
                'dimensionY
             End If

'Fin del ejemplo