how to get width and height of picture with VBA function?

[God Itself]

Hi,

i use such a function to paste jpg file into wkrosheet:

Function ImpPicture(PicPath As String) As String
Dim sh As Shape

With Application.Caller

For Each sh In .Parent.Shapes
If sh.TopLeftCell.Address = .Address Then
sh.Delete
Exit For
End If
Next

ImpPicture = Dir(PicPath)

If ImpPicture <> "" Then
With .Parent.Shapes.AddPicture(Sciezka, True, True, .Left + 1, .Top +
1, .Width - 2, .Height - 2)
.Placement = xlMoveAndSize
End With
End If
End With

End Function

but i'd like also get width and height of pasted picture with another
function.

could anyone help with this?

rgs

 

[Joel]

Picture are a pain in Excel. The naming convention is kind of random and not
consistent. Hard to get the names and you can't change the name property.
You have to do a search for the pictures as a shape or use the index method.
below is the way I normal find the name of the picture(s) on a worksheet.
This code should help.


Sub getdimensions()

For Each myshape In ActiveSheet.Shapes
MsgBox ("Picture name = " & myshape.Name & _
", Height = " & myshape.Height & _
", Width = " & myshape.Width)

Next myshape

End Sub

 

[God Itself]

Hi,

sorry, i didn't mentioned that i mean picture which is located in folder

in example: value in cell B1 is full path to this picture: C:\pics\1.jpg

i'd like to get dimensions of this file without pasting it into worksheet
with VBA function.
Such a function should have only one argument - path to file

regards

 

[Steve Yandl]

This might do what you want, at least for some picture types. The
dimensions are returned as width by height in pixels.

__________________________________

Private Function PictureDimensions(filePath As String) As String

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

If Not FSO.FileExists(filePath) Then
PictureDimensions = ""
End If

strParent = FSO.GetParentFolderName(filePath)
strArgFileName = FSO.GetFileName(filePath)
Set objFolder = objShell.Namespace(strParent)

For Each strFileName In objFolder.Items
If objFolder.GetDetailsOf(strFileName, 0) = strArgFileName Then
PictureDimensions = objFolder.GetDetailsOf(strFileName, 26)
End If
Next

Set FSO = Nothing
Set objShell = Nothing

End Function

_________________________________

Steve Yandl