Lecture DPI du fichier image

Question

Bonjour,

Je souhaite rogner des images via le code VBA. En raison de la raison que les images peuvent se produire dans deux résolutions différentes (96x96 DPI et 300x300 DPI), j'ai besoin de savoir ce que res. le fichier image doit le recadrer correctement. Le format de fichier de ces images est .tif.

Sur Internet, je trouve le code suivant qui utilise un FSO pour obtenir le fichier d'attributs d'image:

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

C'est là que ça se complique. Je peux seulement voir combien d'attributs une image a mais ne peux pas aller plus loin dans eux. Il y a plus de code here mais celui-ci ne fonctionne que pour le format jpg.

Quelqu'un peut-il m'aider?

Answer 1

Quelque chose comme ça devrait fonctionner.

Vous pouvez utiliser l'objet Shell.Application pour récupérer les détails d'un fichier. Le DPI est réparti sur deux propriétés. Le Horizontal Resolution et le Vertical Resolution.

Voici un bref exemple qui va itérer un dossier et vous donner le DPI pour chaque image.

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

merci de répondre. Votre code est presque le même que celui que j'utilise actuellement. J'ai juste besoin d'une résolution, donc je n'ai pas écrit une seconde valeur. De plus, je fais quelques ajustements de chaîne, car il retourne

« ? 96 dpi »

Je suis donc en mesure de retourner la valeur DPI avec une seule commande. Voici le code que j'utilise. J'espère que cela aide d'autres personnes aussi!

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