UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Resizing Pictures From VBA, Access 2010    
 
   
cyanidem
post Mar 3 2016, 06:21 AM
Post#1



Posts: 113
Joined: 18-November 15
From: Consett, UK


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?
Go to the top of the page
 
Marsupilami72
post Mar 3 2016, 08:33 AM
Post#2



Posts: 429
Joined: 17-April 12
From: Germany


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.
Go to the top of the page
 
cyanidem
post Mar 3 2016, 08:46 AM
Post#3



Posts: 113
Joined: 18-November 15
From: Consett, UK


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...
Go to the top of the page
 
Marsupilami72
post Mar 3 2016, 08:58 AM
Post#4



Posts: 429
Joined: 17-April 12
From: Germany


What about IrfanView portable? You could call it from a network drive...(just an idea, i did not try it...)
Go to the top of the page
 
cyanidem
post Mar 3 2016, 09:17 AM
Post#5



Posts: 113
Joined: 18-November 15
From: Consett, UK


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
Go to the top of the page
 
esancha
post Mar 3 2016, 12:22 PM
Post#6



Posts: 86
Joined: 4-October 14
From: Spain


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
Go to the top of the page
 
cheekybuddha
post Mar 3 2016, 02:11 PM
Post#7


UtterAccess VIP
Posts: 11,717
Joined: 6-December 03
From: Telegraph Hill


Emilio,

Very nice! hat_tip.gif

Thanks for sharing! thanks.gif
Go to the top of the page
 
esancha
post Mar 3 2016, 02:28 PM
Post#8



Posts: 86
Joined: 4-October 14
From: Spain


Glad to hear.

Kind Regards
Emilio Sancha
Access MVP 2006-2011
Go to the top of the page
 
cyanidem
post Mar 3 2016, 04:55 PM
Post#9



Posts: 113
Joined: 18-November 15
From: Consett, UK


Whoa, this is great, thanks a lot Emilio!
Go to the top of the page
 
esancha
post Mar 3 2016, 04:59 PM
Post#10



Posts: 86
Joined: 4-October 14
From: Spain


It is a pleasure

Kind Regards
Emilio Sancha
Access MVP 2006-2011
Go to the top of the page
 
soggycashew
post Sep 11 2019, 11:46 AM
Post#11



Posts: 357
Joined: 23-April 13
From: WV, USA


Thank you its what I needed!
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    20th November 2019 - 10:15 AM