阅读图像文件的DPI

我想通过VBA代码裁剪图片。由于图像可能以两种不同的分辨率出现（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格式。

任何人都可以帮助我吗？

来源

2017-07-18 Marco Faulhaber

像这样的东西应该工作。

您可以使用Shell.Application对象检索文件详细信息。 DPI分布在两个属性。 Horizontal Resolution和Vertical 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

来源

2017-07-19 01:25:50

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

“？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

来源

2017-07-19 09:05:50

阅读图像文件的DPI

回答

相关问题