Printable Version of Topic

Click here to view this topic in its original format

UtterAccess Forums _ Access Modules _ Resizing Pictures From VBA

Posted by: cyanidem Mar 3 2016, 06:21 AM

Hello All,

Does anyone know a method to resize external pictures (mainly jpg, png) using VBA?
In one of my projects I need to store pictures for inspections. Button click opens FileDialog, user searches for file which is then copied to specific folder and path to it is stored in db. What I want to do is: before copying it to db folder I'd like to check if it's longer dimension exceed some set size (let's say 2500px) and if it does, reduce longer edge to 2500px keeping proportions of course and save new file as jpg in desired folder.
Anyone has some proven methods to do this kind of stuff?

Posted by: Marsupilami72 Mar 3 2016, 08:33 AM

I would use an external tool like IrfanView to do this - you can call it via VBA with the appropriate command line options and store the resulting picture to your folder.

Posted by: cyanidem Mar 3 2016, 08:46 AM

Thanks, I thought of that but it's not really feasible on 10+ workstations. I'd have to install IV on every one of them, not sure if IT would be happy...

Posted by: Marsupilami72 Mar 3 2016, 08:58 AM

What about IrfanView portable? You could call it from a network drive...(just an idea, i did not try it...)

Posted by: cyanidem Mar 3 2016, 09:17 AM

That may work, thanks. I guess it would still require 10+ licenses, but at least I won't have to deal with IT masterrace wink.gif

Posted by: esancha Mar 3 2016, 12:22 PM

Hello!

sorry for my poor English, I usually use the following code

You will need to set a reference to Microsoft Windows Image Acquisition Library v2.0


Kind Regards
Emilio Sancha
Access MVP 2006-2011




'****************************************************************************
***
'* Redimensionar
'* re-escala la imagen pasada como parámetro
'* Deberá incluir una referencia a Microsoft Windows Image Acquisition Library vX.X
'* Argumentos: strArchivo => ruta del archivo a redimensionar
'* lngAlto => alto en pixels a aplicar
'* lngAncho => ancho en pixels a aplicar
'* uso: Redimensionar "C:\Temp\prueba.PNG"
'* ESH 16/08/09
'* Si utilizas este codigo, respeta la autoría y los créditos
'****************************************************************************
***

Public Sub Redimensionar(strArchivo As String, lngAlto As Long, lngAncho As Long)
Dim Imagen As WIA.ImageFile, _
IP As WIA.ImageProcess, _
strEscalado As String

On Error GoTo Redimensionar_TratamientoErrores

Set Imagen = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")

Imagen.LoadFile (strArchivo)
IP.Filters.Add (IP.FilterInfos("Scale").FilterID)
IP.Filters(1).Properties("MaximumWidth").Value = lngAncho
IP.Filters(1).Properties("MaximumHeight").Value = lngAlto
Set Imagen = IP.Apply(Imagen)

strEscalado = Replace$(strArchivo, ".", ".redim.")
' si el archivo ya existe lo elimino
If Not Dir$(strEscalado) = vbNullString Then Kill strEscalado
Imagen.SaveFile (strEscalado)


Redimensionar_Salir:
If Not Imagen Is Nothing Then Set Imagen = Nothing
If Not IP Is Nothing Then Set IP = Nothing
On Error GoTo 0
Exit Sub

Redimensionar_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: Redimensionar de Módulo: mdlEscanearWIA (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume Redimensionar_Salir

End Sub ' Redimensionar

Posted by: cheekybuddha Mar 3 2016, 02:11 PM

Emilio,

Very nice! hat_tip.gif

Thanks for sharing! thanks.gif

Posted by: esancha Mar 3 2016, 02:28 PM

Glad to hear.

Kind Regards
Emilio Sancha
Access MVP 2006-2011

Posted by: cyanidem Mar 3 2016, 04:55 PM

Whoa, this is great, thanks a lot Emilio!

Posted by: esancha Mar 3 2016, 04:59 PM

It is a pleasure

Kind Regards
Emilio Sancha
Access MVP 2006-2011

Posted by: soggycashew Sep 11 2019, 11:46 AM

Thank you its what I needed!