画像ファイルのDPIを読む

Question

おはよう、

VBAコードで画像を切り抜きたい。イメージが2つの異なる解像度（96x96 DPIと300x300 DPI）で発生する可能性がある理由のために、私は何の解像度を知る必要があります。画像ファイルは正しく切り抜かなければなりません。これらの画像のファイル形式は.tifです。それは複雑になるところです

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

：インターネット上で

は、私は、画像ファイルの属性を取得するためにFSOを使用して、次のコードを見つけました。私は、画像にいくつの属性があるのか​​しかわかりませんが、それ以上の属性はありません。より多くのコード hereがありますが、これはjpg形式でのみ動作します。

誰でも手伝ってもらえますか？

Answer 1

何かこれはうまくいくはずです。

Shell.Applicationオブジェクトを使用して、ファイルの詳細を取得できます。 DPIは2つのプロパティに分散されています。 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 

Answer 2

お返事ありがとうございます。あなたのコードは私が現在使っているコードとほとんど同じです。私はただ一つの解決策が必要なので、私は第二の価値を書いていませんでした。それは

を返すので、さらに、私は「？96 dpiの」

だから私は1つのコマンドで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