|
|
VBA > Image > Resize Image WIA
Resize an image with VBA using capabilities provided by Windows using the Windows Image Acquisition (WIA) library. Contributed by Geoff Griffith.
|
|
|
Resize an image with VBA using capabilities provided by Windows using the Windows Image Acquisition (WIA) library. Contributed by Geoff Griffith.
Resize a picture
Resize an image by specifying the path\file to the image (ImageFilePath), the new path\file (SaveFilePath), whether or not to overwrite if it is already there (OverwriteFile), and the new maximum height and width (NewMaxHeigth, NewMaxWidth). The image will be scaled and keep its aspect ratio. Customize ResizeImage_launch to test and pattern after.
Define an error handler.
Dimension variables, and use late binding so the Microsoft Windows Image Acquisition and Microsoft Scripting Runtime libraries don't have to be referenced.
Initialize bResult, assigned to the return value, to be false.
Make sure the original image file, ImageFilePath, exists.
If SaveFilePath already exists, verify that the original image, ImageFilePath, and save file, SaveFilePath, are actually different files. Overwriting the original image is not allowed. If SaveFilePath already exists and OverwriteFile isn't true, give the user a message and exit. If OverwriteFile is true, use Kill to first delete the file specified by SaveFilePath.
Use the Windows Image Acquisition library to load the image file into oImageFile using CreateObject and then LoadFile.
Create the new size filter and apply it to the image.
Save the resized image file, and set bResult to be true for success
Assign function return to bResult and exit.
If an error happened, give user a message with the error description and number, and exit.
Geoff said that they both work for checking an empty string, but vbNullString is the proper way to check for an empty string. Perhaps this is so the code will work properly for all region settings. (Personal note: a long time ago, I made a note that using vbNullString to compare to the return of Dir didn't work and "" did ... didn't write down the circumstance, so don't remember anymore why, just something to keep in mind -- adjust till it works ~ and add comments!)
ImageFilePath and SaveFilePath might be different but actually point to the same place.
Modify ResizeImage_launch with your parameters for testing and patterning after for your calling procedure.
Run WIA_ImageProcess_FilterInfos_enum to see what filters you can set for the image. Press Ctrl-G to see what was written in the Debug Window.
' Module Name: mod_ResizeImage_WIA_GG '*************** Code Start ***************************************************** '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Name: VBA Image Resize Function ' ' Author: Geoffrey L. Griffith ' ' Company: Imagine Thought Software (http://www.imaginethought.com) ' ' Version: 1.0 ' ' Copyright: 2012 ' ' License: Free to use, share, and modify. All usage must include this set of comments, ' ' including the author, company, version, copyright, and license information. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Name: ResizeImage() ' ' ' ' Description: ImageResize() - Resizes an image proportionally and saves the scaled image ' ' to a new file. The new height and width are determined by ' ' this function's parameter settings. Image will be scaled ' ' proportionally and will retain the same aspect ratio. ' ' ' ' Parameters: ImageFilePath - The full file name and path to the image to be resized. This ' ' file will not be altered by this function. ' ' ' ' SaveFilePath - The full file name and path to save the new resized image at. ' ' If the OverwriteFile parameter is set to True, any existing ' ' file specified by the variable will be overwritten, unless it ' ' is the original image file, which CANNOT be overwritten. ' ' ' ' OverwriteFile - Specifies whether or not to overwrite the file specified in ' ' the SaveFilePath parameter, if that file exists. A value of ' ' True will overwrite the existing file, False will cancel this ' ' resize operation if the file already exists. ' ' ' ' NewMaxHeigth - The new maximum height of the image in pixels. ' ' ' ' NewMaxWidth - The new maximum width of the image in pixels. ' ' ' ' Returns: True if the resize operation was completed successfully, otherwise False. ' ' This function will show error messages if an error occurs. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function ResizeImage( _ ImageFilePath As String, _ SaveFilePath As String, _ OverwriteFile As Boolean, _ NewMaxHeigth As Long, _ NewMaxWidth As Long) As Boolean On Error GoTo ErrorHandler ' ' Using libraries: Microsoft Windows Image Acquisition Library v2.0 ' Microsoft Scripting Runtime ' Dim oImageFile As Object ' WIA.ImageFile Dim oImageProcess As Object ' WIA.ImageProcess Dim oFSO As Object ' Scripting.FileSystemObject Dim bResult As Boolean bResult = False ' Check the original image file If Dir$(ImageFilePath) = vbNullString Then MsgBox "Image file path is invalid.", vbCritical, "Error" GoTo ExitFunction End If ' Check the save file path If (Dir$(SaveFilePath) <> vbNullString) Then ' Save file already exists ' Verify the original image and save file are different files - overwriting ' the original image is not allowed. Set oFSO = CreateObject("Scripting.FileSystemObject") If oFSO.GetAbsolutePathName(SaveFilePath) = oFSO.GetAbsolutePathName(ImageFilePath) Then MsgBox "Save file cannot be the original image file.", vbCritical, "Error" GoTo ExitFunction End If ' Determine if file should be overwritten If OverwriteFile Then Kill SaveFilePath ' Delete the existing save file. Else MsgBox "Save file already exists. Resize cancelled.", vbCritical, "Error" GoTo ExitFunction End If End If ' Load the original image file Set oImageFile = CreateObject("WIA.ImageFile") oImageFile.LoadFile ImageFilePath ' Create the new size filter and apply it to the image Set oImageProcess = CreateObject("WIA.ImageProcess") oImageProcess.Filters.Add oImageProcess.FilterInfos("Scale").FilterID oImageProcess.Filters(1).Properties("MaximumHeight").Value = NewMaxHeigth oImageProcess.Filters(1).Properties("MaximumWidth").Value = NewMaxWidth Set oImageFile = oImageProcess.Apply(oImageFile) ' Save the resized image file oImageFile.SaveFile SaveFilePath ' Set result true for success bResult = True ExitFunction: ResizeImage = bResult Exit Function ErrorHandler: MsgBox Err.Description & vbNewLine & "Number: " & Err.Number, vbCritical, "Error" Resume ExitFunction End Function '--------------------------------------------------------------------------------' ResizeImage_launch
'--------------------------------------------------------------------------------' Public Sub ResizeImage_launch() If ResizeImage("C:\OriginalImageFileName.jpg", "C:\OutputImageFileName.jpg", True, 100, 100) Then MsgBox "Image Resized Successfully!", , "Success" Else MsgBox "ResizeImage() Failed!", , "Error" End If End Sub '*************** Code End ***************************************************** '*************** Enumerate **************************************************** '--------------------------------------------------------------------------------' WIA_ImageProcess_FilterInfos_enum
'--------------------------------------------------------------------------------' Sub WIA_ImageProcess_FilterInfos_enum() '190202 s4p Dim oFilter As Object For Each oFilter In CreateObject("WIA.ImageProcess").FilterInfos With oFilter Debug.Print .Name & ": " & .Description & vbCrLf End With 'oFilter Next oFilter Set oFilter = Nothing End Sub 'provided by www.MsAccessGurus.com/code.htm '*************** End Enumerate ************************************************
I posted code to resize an image by shelling to Irfanview, a freeware image viewer and editor. Upon asking Geoff what he thought of it, he told me you can resize images without shelling! and sent his ResizeImage code. Nice!
Help: Windows Image Acquisition (WIA)
To document the filters you can use, run WIA_ImageProcess_FilterInfos_enum. This is the output with bold added and spacing slightly adjusted:
RotateFlip: Rotates, in 90 degree increments, and Flips, horizontally or vertically.
RotationAngle - Set the RotationAngle property to 90, 180, or 270 if you wish
to rotate, otherwise 0 [the default]
FlipHorizontal - Set the FlipHorizontal property to True if you wish to flip
the image horizontally, otherwise False [the default]
FlipVertical - Set the FlipVertical property to True if you wish to flip
the image vertically, otherwise False [the default]
FrameIndex - Set the FrameIndex property to the index of a frame if you
wish to modify a frame other than the ActiveFrame,
otherwise 0 [the default]
Crop: Crops the image by the specified Left, Top, Right, and Bottom margins.
Left - Set the Left property to the left margin (in pixels)
if you wish to crop along the left, otherwise 0 [the default]
Top - Set the Top property to the top margin (in pixels)
if you wish to crop along the top, otherwise 0 [the default]
Right - Set the Right property to the right margin (in pixels)
if you wish to crop along the right, otherwise 0 [the default]
Bottom - Set the Bottom property to the bottom margin (in pixels)
if you wish to crop along the bottom, otherwise 0 [the default]
FrameIndex - Set the FrameIndex property to the index of a frame if you
wish to modify a frame other than the ActiveFrame,
otherwise 0 [the default]
Scale: Scales image to the specified Maximum Width and Maximum Height preserving
Aspect Ratio if necessary.
MaximumWidth - Set the MaximumWidth property to the width (in pixels)
that you wish to scale the image to.
MaximumHeight - Set the MaximumHeight property to the height (in pixels)
that you wish to scale the image to.
PreserveAspectRatio - Set the PreserveAspectRatio property to True
[the default] if you wish to maintain the current aspect
ration of the image, otherwise False and the image will
be stretched to the MaximumWidth and MaximumHeight
FrameIndex - Set the FrameIndex property to the index of a frame if
you wish to modify a frame other than the ActiveFrame,
otherwise 0 [the default]
Stamp: Stamps the specified ImageFile at the specified Left and Top coordinates.
ImageFile - Set the ImageFile property to the ImageFile object that you wish
to stamp
Left - Set the Left property to the offset from the left (in pixels)
that you wish to stamp the ImageFile at [default is 0]
Top - Set the Top property to the offset from the top (in pixels) that
you wish to stamp the ImageFile at [default is 0]
FrameIndex - Set the FrameIndex property to the index of a frame if you wish to
modify a frame other than the ActiveFrame, otherwise 0
[the default]
Exif: Adds/Removes the specified Exif Property.
Remove - Set the Remove property to True if you wish to remove the
specified Exif property, otherwise False [the default] to add the
specified exif property
ID - Set the ID property to the PropertyID you wish to Add or Remove
Type - Set the Type property to indicate the WiaImagePropertyType of the
Exif property you wish to Add (ignored for Remove)
Value - Set the Value property to the Value of the Exif property you wish
to Add (ignored for Remove)
FrameIndex - Set the FrameIndex property to the index of a frame if you
wish to modify a frame other than the ActiveFrame,
otherwise 0 [the default]
Frame: Adds/Removes the specified Frame.
Remove - Set the Remove property to True if you wish to remove the
specified FrameIndex, otherwise False [the default] to Insert the
ImageFile before the specified FrameIndex
ImageFile - Set the ImageFile property to the ImageFile object whose
ActiveFrame that you wish to add (ignored for Remove)
FrameIndex - For Remove, set the FrameIndex property to the index of the frame
you wish to remove, otherwise for add, set the FrameIndex to the
index of the frame to insert the ImageFile before, otherwise 0
[the default] to append a frame from the ImageFile specified
ARGB: Updates the image bits with those specified.
ARGBData - Set the ARGBData property to the Vector of Longs that represent
the ARGB data for the specified FrameIndex (the width and height
must match)
FrameIndex - Set the FrameIndex property to the index of the frame whose ARGB
data you wish to modify, otherwise 0 [the default] to modify the
ActiveFrame
Convert: Converts the resulting ImageFile to the specified type.
FormatID - Set the FormatID property to the supported raster image format
desired, currently you can choose from wiaFormatBMP,
wiaFormatPNG, wiaFormatGIF, wiaFormatJPEG, or wiaFormatTIFF
Quality - For a JPEG file, set the Quality property to any value from 1 to
100 [the default] to specify quality of JPEG compression
Compression - For a TIFF file, set the Compression property to CCITT3, CCITT4,
RLE or Uncompressed to specify the compression scheme,
otherwise LZW [the default]
If needed, here is code to Make a Path.
here's the link to copy:
https://MsAccessGurus.com/VBA/Code/WIA_ResizeImage_GG.htm
It is interesting to hear from you. Was something not clear? Did you find a bug? Is an explanation wrong or not sufficient? Do you want the code do more? (there is always more)
Some of you write to say thanks and share what you're doing with Access ... nice to hear from you! It is my desire that you build great applications with Access, design your database structure well, link to and share with data in other formats, and use other Office applications such as Excel, Word, and PowerPoint, ... take advantage of built-in abilities, use strengths of each product, and manage your information wisely.
Are you a developer? Do you want to share? Email to ask about getting your pages added to the code index.
When we communicate, collaborate, and appreciate, we all get better.
Thank you.
Email me at info@msAccessGurus