Как получить размер плаката в Excel Macro

Question

Как узнать размер постеров с помощью vba excel.Я использую операционную систему Windows 7.

Изображения присутствуют по другому пути.Ex.d:\posterbank\a.jpeg,b.jpeg и файл excel содержит только такие имена, как a.jpeg, b.jpeg.

Я хочу проверить, есть ли эти плакаты, если да, нужно проверить их размер.

Answer 1

Это должно помочь вам начать :) Я взял пример с 1 рисунка, я уверен, что вы можете изменить его, чтобы зациклить соответствующие ячейки и получить значения:)

ПРОВЕРЕНО И ИСПЫТАНО

'~~> 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

Answer 2

Это сработало для меня

  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

Answer 3

Не тестировалось, но с использованием this в качестве справки, похоже, что можно загрузить изображение следующим образом.

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

И затем получить ширину и высоту вот так.

myImg.height
myImg.width