Für 32Bit und 64Bit Office Versionen
Problemstellung:
Manchmal möchte man die Pixelgrößen von Bilddateien mit Hilfe von Access ermitteln.
Lösung:
Es werden Bilder in den Formaten GIF, BMP und JPG ünterstützt.
Folgende Funktion in ein öffentliches Modul kopieren:
Public Type PictureFormat
sWidth As String
sHeight As String
End Type
Public Function GetPicSize(sFile As String) As PictureFormat
Dim ff As Integer
Dim iWidth As Integer
Dim iHeight As Integer
Dim iC As Integer
Dim sTmp As String
Dim lL As Long
Dim sDummy As String
Dim sExt As String
sExt = Right(sFile, 3)
ff = FreeFile()
Open sFile For Binary Access Read As #ff
Select Case sExt
Case "gif"
Get #ff, 7, iWidth
Get #ff, 9, iHeight
Close #ff
Case "bmp"
Get #ff, 19, iWidth
Get #ff, 23, iHeight
Close #ff
Case "jpg"
If Input(2, #ff) <> (Chr$(&HFF) & Chr$(&HD8)) Then
Close #ff
Exit Function
End If
sDummy = Input(2, #ff)
Do
lL = Asc(Input(1, #ff))
lL = lL * 256 + Asc(Input(1, #ff))
sTmp = Input(lL - 2, #ff)
If iC = &HC0 Or iC = &HC2 Then
iWidth = Asc(Mid$(sTmp, 4, 1))
iWidth = iWidth * 256 + Asc(Mid$(sTmp, 5, 1))
iHeight = Asc(Mid$(sTmp, 2, 1))
iHeight = iHeight * 256 + Asc(Mid$(sTmp, 3, 1))
End If
If Input(1, #ff) <> Chr$(255) Then
Exit Do
End If
iC = Asc(Input(1, #ff))
Loop While iC <> &HD9
Close #ff
Case Else
Exit Function
End Select
With GetPicSize
.sWidth = CStr(iWidth)
.sHeight = CStr(iHeight)
End With
End Function
Der Aufruf z.B.:
Dim tPictureFormat As PictureFormat
tPictureFormat = GetPicSize("F:\Downloads\Bilder\anz_wt.gif")
MsgBox "Bildbreite: " & tPictureFormat.sWidth & " Pixel" & vbNewLine & _
"Bildhöhe: " & tPictureFormat.sHeight & " Pixel"
Das Ergebnis:
