如何在Excel宏中獲取海報尺寸

Question

如何使用vba excel獲取海報尺寸。我正在使用Windows 7操作系統。

圖像存在於其他路徑上。防爆。 d:\posterbank\a.jpeg,b.jpeg和excel文件只包含像a.jpeg, b.jpeg這樣的名稱。

我想檢查這些海報是否存在，如果是需要檢查這些海報的大小。

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 

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

沒有測試，但是使用this作爲參考，它看起來像它應該是可能的加載圖像是這樣的。

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

然後獲得像這樣的寬度和高度。

myImg.height 
myImg.width 

Answer 3

這爲我工作

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