How to points Width and Height from LoadImage() in PowerPoint - vba

Question

I am using LoadPicture method in my macro to load an jpg image. I want to know its width and height but the values that I get are not useful. I try to find a solution in some forums and I saw this solution:
Set oBmp = LoadPicture(FileName)
Hght = ScaleX(oBmp.Width, vbHimetric, vbPixels)
Wdth = ScaleY(oBmp.Height, vbHimetric, vbPixels)
The problem is that in powerpoint ScaleX and ScaleY are not working. At least in my powerpoint gives me the compile error: Method or data member not found.
I am also trying with this peace of code:
Dim myPic As IPictureDisp
Set myPic = LoadPicture("C:\dink_template\dinkFile\sizeimage.jpg")
Hght = myPic.height
wid = myPic.width
I check the image and his size in pixels are height = 132px and width= 338px but with that I am getting Height = 2794 and width 7154
How can I use the ScaleX/ScaleY in powerpoint? Or if I cannot use them how can pass the values to pixel?

Answer 1

This was fairly tricky. The dimensions you're receiving from the .Width and .Height property are actually OLE_YSIZE_HMETRIC/OLE_XSIZE_HMETRIC, which from what I can find out, are an increment of measurement representing 0.01mm.
I didn't initially see any easy workaround for this, (formula or at least a WinAPI function that would be helpful).
This should work for most users who have normal/default screen resolution settings
Function uses late-binding/does not require a reference to Publisher, although the library still needs to be available on user's machine.
Option Explicit
Sub Test()
Dim filepath$
filePath = "C:\image_file.JPG"
MsgBox "Height = " & GetImageDimensions(filepath)(0) & vbNewLine & _
"Width = " & GetImageDimensions(filepath)(1), vbOKOnly, "Dimensions"
End Sub
Function GetImageDimensions(filepath) As Variant
'Function returns an array of (Height, Width) from a specific image file path
'
Dim tmp(0 To 1) As Long
Dim oPub As Object
Set oPub = CreateObject("Publisher.Application")
'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
' these are representing 0.01 mm
With LoadPicture(filepath)
'Multiply by 0.01 to get dimension in millimeters, then
' use the MS Publisher functions to convert millimeters -> points -> pixels
tmp(0) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Height))
tmp(1) = 0.01 * oPub.PointsToPixels(oPub.MillimetersToPoints(.Width))
End With
GetImageDimensions = tmp
End Function
Here is a test case:
And here are the results:
UPDATE FROM COMMENTS
I get the following dimensions while debugging:
.Height = 3493
.Width = 8943
However, you indicate that you get 2794 and 7154, respectively.
I can replicate your results when I change screen resolution (e.g., 125%). The method below should resolve that discrepancy.
Attempting to use WinAPI to (hopefully) account for whatever discrepancy we're getting (pixel size, perhaps is different on your computer, which could cause this, although I'd expect the Publisher functions would account for this...)
This function with WinAPI call should work for all users, regardless of resolution
Function GetImageDimensions2(filePath As String) As Variant
'Function returns an array of (Height, Width) from a specific image file path
Dim tmp(0 To 1) As Long
'returning picture.width in OLE_YSIZE_HIMETRIC/OLE_XSIZE_HIMETRIC
' these are representing 0.01 mm
With LoadPicture(filePath)
tmp(0) = .Height / 2540 * (1440 / TwipsPerPixelY())
tmp(1) = .Width / 2540 * (1440 / TwipsPerPixelX())
End With
GetImageDimensions2 = tmp
End Function
And include these WinAPI calls in another module:
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
'--------------------------------------------------
Function TwipsPerPixelX() As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
ReleaseDC HWND_DESKTOP, lngDC
End Function
'--------------------------------------------------
Function TwipsPerPixelY() As Single
'--------------------------------------------------
'Returns the height of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
ReleaseDC HWND_DESKTOP, lngDC
End Function