Here is a fix for the Function

Sub ReadGIF(ByRef pStrPath, lHeight As Long, lWidth As Long)
Dim ff As Long, wDbl As Double, hDbl As Double
Dim b() As Byte
If Not UCase(Right(pStrPath, 4)) = ".GIF" Then Exit Sub
ff = FreeFile
ReDim b(1 To 10)
Open pStrPath For Binary As #1
For i = 1 To 10
Get #1, i, b(i)
Next
Close #ff


lWidth = 0: lHeight = 0
wDbl = CDbl(b(8)) * 256#
hDbl = CDbl(b(10)) * 256#
lWidth = wDbl + b(7)
lHeight = hDbl + b(9)

End Sub

this returns the measurements in Pixels.

--
Regards,
Tom Ogilvy


"fishbyname" wrote in message
ps.com...
On Mar 15, 7:26 pm, Tom Ogilvy
wrote:
Sub pic()

Dim rng As Range
Dim shp As Comment
Dim s as String, h as Long
Dim w as Long

findlastrow
s = "c:\Screenshots\" & Range("H" & i).Value & ".gif"
ReadGif s, h, w
if w = 0 then exit sub
For i = 12 To first_blank - 1

Set rng = Range("H" & i)

If Not rng.Comment Is Nothing Then
rng.Comment.Delete
End If

If rng.Text < "" Then

Set shp = rng.AddComment("")
shp.Shape.Fill.UserPicture s
shp.Shape.width = w
shp.Shape.Height = h

End If

Next i

End Sub

Sub ReadGIF(ByRef pStrPath, lHeight As Long, lWidth As Long)
Dim ff As Long
Dim lStrData As String * 20
If Not UCase(Right(pStrPath, 4)) = ".GIF" Then Exit Sub

ff = FreeFile
Open pStrPath For Input As #1
Input #ff, lStrData
Close #ff
If Len(lStrData) < 10 Then Exit Sub
lWidth = 0: lHeight = 0
If Not Left(lStrData, 3) = "GIF" Then Exit Sub
lWidth = CInt("&h" & _
Right("0" & Hex(Asc(Mid(lStrData, 8, 1))), 2) & _
Right("0" & Hex(Asc(Mid(lStrData, 7, 1))), 2) _
)

lHeight = CInt("&h" & _
Right("0" & Hex(Asc(Mid(lStrData, 10, 1))), 2) & _
Right("0" & Hex(Asc(Mid(lStrData, 9, 1))), 2) _
)
End Sub

--
Regards,
Tom Ogilvy

"fishbyname" wrote:
that will get the size of the shape but i need the size of the image
in the file to be able to set the dimensions of the shape

here is the code i have at the moment:

Sub pic()

Dim rng As Range
Dim shp As Comment

findlastrow

For i = 12 To first_blank - 1

Set rng = Range("H" & i)

If Not rng.Comment Is Nothing Then
rng.Comment.Delete
End If

If rng.Text < "" Then

Set shp = rng.AddComment("")
shp.Shape.Fill.UserPicture "c:\Screenshots\" &
Range("H" & i).Value & ".gif"

shp.Shape.width = 111
shp.Shape.Height = 92

End If

Next i

End Sub

i want to be change the values of 111 and 92 to the width and height
of the picture it is inserting in the previous line

thanks for the code, it almost works but for some reason it sets
dimensions to be much bigger than they actually are

eg Width = 176 Height = 44... Width in code = 8224 Height = 8368

do you know what is causing this?

thanks