bildgrösse von jpg-dateien ermitteln

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: bildgrösse von jpg-dateien ermitteln
von: meggle
Geschrieben am: 01.12.2003 16:43:40

hallo,
ich möchte gerne die bildgrösse von jpg-dateien ermitteln (in Pixel / breite x höhe). es ist mir egal ob die dateien in excel eingefügt werden müssen oder nicht.

danke im vorraus

Bild


Betrifft: AW: bildgrösse von jpg-dateien ermitteln
von: Coach
Geschrieben am: 01.12.2003 18:41:19

Hallo Meggle,

hier eine Lösung aus dem Forum, Spender habe ich nicht notiert:

Sub prüfenJPG()
Dim Width As Long, Height As Long
Dim Pfad As Variant
Dim ret As Boolean
icount = -1
Pfad = Application.GetOpenFilename("Text Files (*.jpg), *.jpg")
If Pfad <> False Then
    ret = SizeJPG(Pfad, Width, Height)
       
    If ret Then
        Pfad = Dir(Pfad)
        MsgBox "Das Bild : " & Pfad & " hat die Formate:" & vbLf & _
            "Höhe:" & vbTab & Height & vbLf & _
            "Breite:" & vbTab & Width
    Else
        MsgBox "Es handelt sich nicht um eine JPG-Datei!", vbCritical, "INFO"
    End If
Else
    MsgBox "Vorgang wurde vom Benutzer abgebrochen!", vbInformation, "INFO"
End If
End Sub


Public

Function SizeJPG(ByRef FilePath As Variant, Width As Long, _
 Height As Long) As Boolean
  Dim nFNr As Long
  Dim nFlag As Integer
  Dim nDummy As String
  Dim nOffset As Long
  Dim nValue As String
  Dim nWidth As Long
  Dim nHeight As Long
 
  nFNr = FreeFile
  Open FilePath For Binary Access Read As #nFNr
    If Input$(1, #nFNr) <> Chr$(255) Then
      Close #nFNr
      Exit Function
    End If
    nFlag = Asc(Input$(1, #nFNr))
    If nFlag <> &HD8 Then
      Close #nFNr
      Exit Function
    End If
    nDummy = Input$(2, #nFNr)
    Do
      nOffset = Asc(Input$(1, #nFNr)) * 256 + _
       Asc(Input$(1, #nFNr))
      nValue = Input$(nOffset - 2, #nFNr)
      If (nFlag = &HC0) Or (nFlag = &HC2) Then
        nWidth = Asc(Mid$(nValue, 4, 1))
        nWidth = nWidth * 256 + Asc(Mid$(nValue, 5, 1))
        nHeight = Asc(Mid$(nValue, 2, 1))
        nHeight = nHeight * 256 + Asc(Mid$(nValue, 3, 1))
      End If
      If Input$(1, #nFNr) <> Chr$(255) Then
        Exit Do
      End If
      nFlag = Asc(Input$(1, #nFNr))
    Loop While nFlag <> &HD9
  Close #nFNr
  Width = nWidth
  Height = nHeight
  SizeJPG = True
End Function


Gruß Coach


Bild


Betrifft: AW: bildgrösse von jpg-dateien ermitteln
von: GerdW
Geschrieben am: 01.12.2003 18:57:24

mit Bild einfügen:

Option Explicit

Sub Bild_einfügen_Größe()
Dim Sh As Object
[b3].Select
Set Sh = ActiveSheet.Pictures.Insert( _
  "C:\Eigene Dateien\Eigene Bilder\Test10mm28Pixel.bmp")
MsgBox "Höhe: " & Sh.Height & " Pixel, " & " Breite: " & Sh.Width & " Pixel"
End Sub


Gerd


Bild


Betrifft: AW: bildgrösse von jpg-dateien ermitteln
von: meggle
Geschrieben am: 02.12.2003 14:28:35

danke soweit mal,

leider wird die pixelgröße falsch angezeigt, es ist ca. 4,16 mal kleiner als das orginal ???

Trotzdem vielen vielen dank...



markus


Bild

Beiträge aus den Excel-Beispielen zum Thema " bildgrösse von jpg-dateien ermitteln"