Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
344to348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
344to348
344to348
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

bildgrösse von jpg-dateien ermitteln

bildgrösse von jpg-dateien ermitteln
01.12.2003 16:43:40
meggle
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bildgrösse von jpg-dateien ermitteln
01.12.2003 18:41:19
Coach
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
Anzeige
AW: bildgrösse von jpg-dateien ermitteln
01.12.2003 18:57:24
GerdW
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
AW: bildgrösse von jpg-dateien ermitteln
02.12.2003 14:28:35
meggle
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige