Get Picture Size

AlexanderBB

Well-known Member
Joined
Jul 1, 2009
Messages
1,835
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I'm loading jpg images to a UserForm with
VBA Code:
Me.Picture = LoadPicture(filename)
and PictureSizeMode set to 1 stretch.
Most pictures are the same width and height so they show correctly. But some are "portrait" size where stretching distorts them. They improve with Size Mode set to Zoom.
Is there any way i can tell the picture dimensions beforehand to set the best PictureSizeMode?
Thanks
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Modified the code from the interwebs, changed it a bit to return a string telling the width and height. The original code returned an array with the dimensions. You can get the original code from the link.

VBA Code:
Function GetImageSize(ImagePath As String) As Variant
Dim imgSize(1)  As Integer
Dim wia As Object

'Check that the image file exists.
If FileExists(ImagePath) = False Then Exit Function

'Check that the image file corresponds to an image format.
If IsValidImageFormat(ImagePath) = False Then Exit Function

'Create the ImageFile object and check if it exists.
On Error Resume Next
Set wia = CreateObject("WIA.ImageFile")
If wia Is Nothing Then Exit Function
On Error GoTo 0

'Load the ImageFile object with the specified File.
wia.LoadFile ImagePath

'Get the necessary properties.
imgSize(0) = wia.Width
imgSize(1) = wia.Height

'Release the ImageFile object.
Set wia = Nothing

'Return the array.
GetImageSize = Join(Array("Width:", imgSize(0), "Height:", imgSize(1)), " ")

End Function

Function FileExists(FilePath As String) As Boolean

'--------------------------------------------------
'Checks if a file exists (using the Dir function).
'--------------------------------------------------

On Error Resume Next
If Len(FilePath) > 0 Then
If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
On Error GoTo 0

End Function

Function IsValidImageFormat(FilePath As String) As Boolean

'----------------------------------------------
'Checks if a given path is a valid image file.
'----------------------------------------------

'Declaring the necessary variables.
Dim imageFormats As Variant
Dim i   As Integer

'Some common image extentions.
imageFormats = Array(".bmp", ".jpg", ".gif", ".tif", ".png")

'Loop through all the extentions and check if the path contains one of them.
For i = LBound(imageFormats) To UBound(imageFormats)
'If the file path contains the extension return true.
If InStr(1, UCase(FilePath), UCase(imageFormats(i)), vbTextCompare) > 0 Then
IsValidImageFormat = True
Exit Function
End If
Next i

End Function
 
Upvote 0

Forum statistics

Threads
1,214,605
Messages
6,120,476
Members
448,967
Latest member
visheshkotha

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top