Read DPI von Image-Datei

Question

Guten Morgen,

Ich möchte Bilder durch VBA-Code zuschneiden. Da Bilder in zwei verschiedenen Auflösungen (96x96 DPI und 300x300 DPI) auftreten können, muss ich wissen, was res. Die Bilddatei muss sie korrekt beschneiden. Das Dateiformat dieser Bilder lautet .tif.

Im Internet fand ich folgenden Code, der eine FSO verwendet die Bilddatei zu erhalten Attribute:

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

Dies ist, wo es kompliziert. Ich kann nur sehen, wie viele Attribute ein Bild hat, kann aber nicht weiter hinein kommen. Es gibt mehr Code here, aber dieser funktioniert nur für das JPG-Format.

Kann mir jemand helfen?

Answer 1

So etwas sollte funktionieren.

Sie können das Objekt Shell.Application verwenden, um Dateidetails abzurufen. Die DPI ist auf zwei Eigenschaften verteilt. Die Horizontal Resolution und die Vertical Resolution.

Hier ist ein kurzes Beispiel, das einen Ordner iteriert und Ihnen die DPI für jedes Bild gibt.

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 

Answer 2

danke für die antwort. Ihr Code ist fast derselbe, den ich gerade benutze. Ich brauche nur eine Auflösung, also habe ich keinen zweiten Wert geschrieben. Außerdem habe ich einige String-Anpassungen, weil es

gibt "? 96 dpi"

So: Ich kann den DPI-Wert mit einem Befehl zurückzukehren. Hier ist der Code, den ich verwende. Ich hoffe, das hilft auch anderen Menschen!

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