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

  • Thread starter Thread starter God Itself
  • Start date Start date
G

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
 
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
 
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
 
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
 
Back
Top