读取图像文件的DPI

时间:2017-07-18 08:28:44

标签: vba excel-vba ms-word word-vba excel

早上好,

我想通过VBA-Code裁剪图片。由于图像可以以两种不同的分辨率(96x96 DPI和300x300 DPI)发生,我需要知道什么是res。图像文件必须正确裁剪。这些图像的文件格式为.tif。

在互联网上,我发现以下代码使用FSO获取图像文件属性:

Dim fso As New FileSystemObject
Debug.Print fso.GetFile("C:\Users\...\Downloads\75.tif").Attributes '<-- 32

这是变得复杂的地方。我只能看到图像有多少属性,但无法进一步了解它们。还有更多代码here,但这只适用于jpg格式。

任何人都可以帮助我吗?

2 个答案:

答案 0 :(得分:0)

这样的事情应该有效。

您可以使用Shell.Application对象来检索文件详细信息。 DPI分布在两个属性上。 Horizontal ResolutionVertical Resolution

这是一个简短的例子,它将迭代一个文件夹并为每个图像提供DPI。

Sub getResolution()
    Const HorizontalRes As Integer = 161
    Const VerticalRes As Integer = 163

    Dim i       As Long
    Dim wsh     As Object: Set wsh = CreateObject("Shell.Application")
    Dim fileObj As Object
    Dim foldObj As Object
    Dim Folder  As Object
    Dim vRes    As String
    Dim hRes    As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the Folder..."
        .AllowMultiSelect = False
        If .Show Then
            Set foldObj = wsh.Namespace(.SelectedItems(1))

            For Each fileObj In foldObj.Items
                vRes = foldObj.GetDetailsOf(fileObj, HorizontalRes)
                hRes = foldObj.GetDetailsOf(fileObj, VerticalRes)

                MsgBox fileObj.Name & vbCrLf & _
                       "Horizontal Resolution: " & hRes & vbCrLf & _
                       "Vertical Resolution: " & vRes
            Next
        End If

    End With

End Sub

答案 1 :(得分:0)

感谢您的回答。您的代码几乎与我目前使用的代码相同。我只需要一个分辨率,所以我没有写第二个值。此外,我做了一些字符串调整,因为它返回

  

“?96 dpi”

所以我可以用一个命令返回DPI值。这是我正在使用的代码。我希望这对其他人也有帮助!

Public Function getDPI() As Integer

    Dim objShell
    Dim objFolder
'   Dim i

    Set objShell = CreateObject("shell.application")
    Set objFolder = objShell.NameSpace("edit path here") ' <-- ToDo

    If (Not objFolder Is Nothing) Then
        Dim objFolderItem

        Set objFolderItem = objFolder.ParseName("edit filename here") ' <-- ToDo

        If (Not objFolderItem Is Nothing) Then
            Dim objInfo
'            For i = 1 To 288
               getDPI = Trim(Mid(objFolder.GetDetailsOf(objFolderItem, 161), 2, 3)) ' <--161 represents the horizontal resolution
'            Next
        End If

        Set objFolderItem = Nothing
    End If

    Set objFolder = Nothing
    Set objShell = Nothing

End Function