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

这为我工作

  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

如何在Excel宏中获取海报大小

3 个答案: