jpg resmin çözünürlüğü

[Tevfik_Kursun]

Merhaba Arkadaşlar,
jpg resmin çözünürlüğü nasıl bulunur? (tabi excel ile)
Saygılarımla

 

[veyselemre]

https://stackoverflow.com/questions/45161371/read-dpi-of-image-file

What is VBA to get the pixel dimensions of a file?

Hi there Is there a way to the obtain the pixel dimensions of a file using VBA? For example, I have a file that according to its dimensions is 300 x 600 pixels...I want the VBA code to put the dimension, in this case, "300 x 600" in a cell I have multiple size files so code needs to work for...

www.mrexcel.com

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
    Dim sat&

    Cells.ClearContents
    [A1].Resize(, 4).Value = Array("File Name", "Dimensions", "Horizontal Resulution", "Vertical Resulution")
    sat = 2
    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
                sat = sat + 1
                vRes = foldObj.GetDetailsOf(fileObj, HorizontalRes)
                hRes = foldObj.GetDetailsOf(fileObj, VerticalRes)
                Cells(sat, 1).Value = fileObj.Name
                Cells(sat, 2).Value = fileObj.ExtendedProperty("Dimensions")
                Cells(sat, 3).Value = hRes
                Cells(sat, 4).Value = vRes
            Next
        End If

    End With

End Sub

Sub GetDetailsOf_codeList()
    Dim i As Integer
    Set Shl = CreateObject("Shell.Application")
    Set Rep = Shl.Namespace("D:\AMASRA")
    For i = 0 To 1000
        Cells(i + 1, 1).Value = Format(i, "000 : ") & Rep.GetDetailsOf(Null, i)
        If Len(Rep.GetDetailsOf(Null, i)) = 0 Then
            Exit For
        End If
    Next
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
İlginize çok teşekkür ederim. Hemen deneyip size döneceğim.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
Ekli resimlerdeki çözünürlük değerini de eklemek mümkün mü? Ya da o değerin nasıl hesaplandığı hakkında bir bilgi var mı?
Saygılarımla

 

[veyselemre]

Resimdeki 37,80 değerinden bahsediyorsanız, 400/10,58 den bulunmuş sanırım. Baskı boyutunun bulunması gerek, bu da yazıcıya ve güncel ayarlarına göre değişiklik gösterebilir. Nasıl bulunacağı hakkında bilgim yok.

 

[Tevfik_Kursun]

Sayın Veysel Emre Hocam,
İlginize çok teşekkür ederim,
Saygılarımla