Hi Joe

I have unfortunately lost the name of the author:

Option Explicit

Type ImageSize
Width As Long
Height As Long
End Type

Sub test()
Dim vPic As Variant
Dim sPicFile As String
Dim uSize As ImageSize

vPic = Application.GetOpenFilename("Jpg images (*.jpg), *.jpg")
If vPic = False Then Exit Sub
sPicFile = CStr(vPic)
If Dir(sPicFile) < "" Then
uSize = GetImageSize(sPicFile)
MsgBox uSize.Width & " * " & uSize.Height
End If
End Sub

Function GetImageSize(ByVal sFileName As String) As ImageSize
On Error Resume Next
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer

lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()

If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
'Debug.print "JPEG"
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) < &HFF) Or lPos lFlen

For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) = &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
GetImageSize.Width = CombineBytes(bWlsb, bWmsb)
GetImageSize.Height = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
End Function

Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256))
End Function

HTH. Best wishes Harald



"Joe HM" skrev i melding
oups.com...
Hello -

I have the following problem: I want to be able to determine the width
of a JPG image from a VB6 script. The user specifies the JPG filename
in a cell and I want the script to somehow load that picture and
determine the width and height.

Is there any way this could be done with VB in Excel?

Thanks!
Joe