How to get poster size in Excel Macro

Question

How to get the size of the posters by using vba excel. I am using windows 7 operating system.

Images are present on some other path. Ex. d:\posterbank\a.jpeg,b.jpeg and excel file contains only names like a.jpeg, b.jpeg.

I want to check if these posters are there if yes need to check size of these.

A = LTrim(RTrim(Sheets(sheetno).Range("m" & rowno).Value))
postername = Left(A, Len(A) - 4) & ".bmp"

If filesys.fileExists(Poster_SPath & "\" & postername) Then
Else: Call appendtofile(vbrLf & "Not found " & Eng_Title & " " & postername, Logfile_Path & "\" & "log.txt")
End If

Can you please explain a little more in detail on what exactly you want? — Siddharth Rout, Mar 22 '12 at 11:54
I am having poster reference column in my excel sheet.i am selecting the poster reference from sheet, Doing check weather poster is present or not. if present check for height and width of poster with some standard Height and width. — Code Hungry, Mar 22 '12 at 11:58
Pardon for my ignorance, but what is a "poster" in Excel? Do you mean this? http://www.gaillovely.com/resources/poster.htm — Siddharth Rout, Mar 22 '12 at 11:59
Posters are nothing but .jpeg image names,Theses are only references. — Code Hungry, Mar 22 '12 at 12:01
So in short you want to check if the sheet has images and if present you want the size of the images? — Siddharth Rout, Mar 22 '12 at 12:02
My sheet doesn't contain image.Images are present on some other path.eg. d:\posterbank\a.jpeg,b.jpeg. and excel file contains only names like a.jpeg, b.jpeg. I want to check if these posters are there if yes need to check size of these. — Code Hungry, Mar 22 '12 at 12:05
let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/9191/discussion-between-siddharth-rout-and-niraj-deshmukh) — Siddharth Rout, Mar 22 '12 at 12:06

score 3 · Accepted Answer · answered Mar 22 '12 at 12:57

This should get you started :) I have taken the example of 1 picture, I am sure you can amend it to loop the relevant cells and pick up the values :)

TRIED AND TESTED

'~~> Path where images reside
Const FilePath As String = "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\"

Sub Sample()
    Dim Filename As String

    '~~> Replace this with the relevant cell value
    Filename = "Sunset.JPG"

    '~> Check if file exists
    If FileFolderExists(FilePath & Filename) = True Then

        '~~> In sheet 2 insert the image temporarily
        With Sheets("Sheet2")
            .Pictures.Insert(FilePath & Filename).Select

            '~~> Get dimensions
            MsgBox "Picture demensions: " & Selection.Width & " x " & Selection.Height

            '~~> Delete the picture
            Selection.Delete
        End With
    End If
End Sub

Public Function FileFolderExists(strFullPath As String) As Boolean
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
    On Error GoTo 0
End Function

Might I recommend `Application.ScreenUpdating = False` here to prevent massive flickering and possible slowdown? — Gaffi, Mar 22 '12 at 13:28

score 2 · Answer 2 · answered Mar 22 '12 at 13:16

This Worked for Me

  Option Explicit 
    Type FileAttributes 
        Name As String 
        Dimension As String 
    End Type 

    Public Function GetFileAttributes(strFilePath As String) As FileAttributes 
         ' Shell32 objects
        Dim objShell As Shell32.Shell 
        Dim objFolder As Shell32.Folder 
        Dim objFolderItem As Shell32.FolderItem 

         ' Other objects
        Dim strPath As String 
        Dim strFileName As String 
        Dim i As Integer 

         ' If the file does not exist then quit out
        If Dir(strFilePath) = "" Then Exit Function 

         ' Parse the file name out from the folder path
        strFileName = strFilePath 
        i = 1 
        Do Until i = 0 
            i = InStr(1, strFileName, "\", vbBinaryCompare) 
            strFileName = Mid(strFileName, i + 1) 
        Loop 
        strPath = Left(strFilePath, Len(strFilePath) - Len(strFileName) - 1) 

         ' Set up the shell32 Shell object
        Set objShell = New Shell 

         ' Set the shell32 folder object
        Set objFolder = objShell.Namespace(strPath) 

         ' If we can find the folder then ...
        If (Not objFolder Is Nothing) Then 

             ' Set the shell32 file object
            Set objFolderItem = objFolder.ParseName(strFileName) 

             ' If we can find the file then get the file attributes
            If (Not objFolderItem Is Nothing) Then 

          GetFileAttributes.Dimension = objFolder.GetDetailsOf(objFolderItem, 36) 

            End If 

            Set objFolderItem = Nothing 

        End If 

        Set objFolder = Nothing 
        Set objShell = Nothing 

    End Function

score 0 · Answer 3 · edited May 23 '17 at 12:20

0

Not tested, but using this as reference, it looks like it should be possible to load the image like this.

set myImg = loadpicture(Poster_SPath & "\" & postername & ".bmp")

And then get the width and height like this.

myImg.height
myImg.width

edited May 23 '17 at 12:20

Community

1
1

answered Mar 22 '12 at 12:56

mattboy

2,870
5
26
40

How to get poster size in Excel Macro

3 Answers3