View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Андрей Андриенко Андрей Андриенко is offline
external usenet poster
 
Posts: 1
Default Excel height and width of a pictures

Hi!

Prompt how to receive parametres of a picture by means of VBA for Excel, namely height and width in pixels.

Which I apply an example more low, does not work properly.

Private Type ThePicInfo

Type As String

Width As Long

Height As Long

End Type

Private Function CheckPicSpecs (TheFile) As ThePicInfo

Dim TheContent, TheImageInfo As ThePicInfo, TheVar, TheFreeFile

TheFreeFile = FreeFile

Open TheFile For Binary As TheFreeFile

TheContent = Input (10, TheFreeFile)

Close TheFreeFile

If Mid (TheContent, 7, 4) = "JFIF" Then

TheImageInfo. Type = "JPG"

Open TheFile For Binary As TheFreeFile

TheContent = Input (167, TheFreeFile)

Close TheFreeFile

TheImageInfo. Height = Asc (Mid (TheContent, 165, 1)) + 256 *

Asc (Mid (TheContent, 164, 1))

TheImageInfo. Width = Asc (Mid (TheContent, 167, 1)) + 256 *

Asc (Mid (TheContent, 166, 1))

End If

If Mid (TheContent, 1, 3) = "GIF" Then

TheImageInfo. Type = "GIF"

TheImageInfo. Width = Asc (Mid (TheContent, 7, 1)) + 256 * Asc (Mid (TheContent,

8, 1))

TheImageInfo. Height = Asc (Mid (TheContent, 9, 1)) + 256 * Asc (Mid (TheContent,

10, 1))

End If

CheckPicSpecs = TheImageInfo

End Function

Private Sub Command1_Click ()

Dim an As ThePicInfo

' as parametre of function CheckPicSpecs instal path to your picture

a = CheckPicSpecs ("D:\garbage\way2house.gif")

MsgBox a. Type

MsgBox a. Width

MsgBox a. Height

End Sub





Thankful in advance