閱讀圖像文件的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

回答

相關問題